DIRECTORY
Atom USING [GetPName],
BasicTime USING [GMT, Now, Period],
BlackCherry,
BlackCherryInternal,
BlackCherrySidedoor,
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
Commander USING [CommandProc, Handle, Register],
CommanderOps USING [NextArgument],
Containers USING [ChildXBound, ChildYBound],
FileNames USING [CurrentWorkingDirectory, GetShortName, StripVersionNumber],
IO,
MailBasics,
MailBasicsFileTypes,
MailRetrieve USING [Close, Create, Handle, MBXState, NewUser],
MailUtils USING [Credentials],
MailSend USING [GetRegisteredSendProcsList, MailSendProcsRef],
Menus USING [CreateEntry, CreateMenu, AppendMenuEntry, FindEntry, Menu, MenuEntry, MenuProc],
PFS,
PFSNames,
PopUpSelection USING [Request],
Process USING [Detach, PauseMsec],
RefText,
Rope,
SendMailOps,
SystemNames USING [SimpleHomeDirectory],
TEditDocument USING [maxClip, TEditDocumentData],
TiogaAccess USING [CharSet, Create, DoneWith, EndOf, Get, Put, Reader, TiogaChar, Writer],
TiogaAccessViewers USING [FromSelection, FromViewer, WriteSelection, WriteViewer],
TiogaButtons USING [TiogaButton, TiogaButtonProc, CreateButton, CreateViewer, ChangeButtonLooks, DeleteButton, SetStyleFromRope],
TiogaMenuOps USING [AllLevels],
TiogaOpsDefs USING [ ],
TiogaOps USING [CancelSelection, FindText, GetSelection, RestoreSelB, SaveSelB, SearchDir, SelectDocument, SetStyle, ViewerDoc],
UserProfile USING [Boolean, Token],
ViewerClasses USING [Column, IconFlavor, Viewer],
ViewerEvents USING [EventProc, EventRegistration, RegisterEventProc, UnRegisterEventProc],
ViewerIO USING [CreateViewerStreams, GetViewerFromStream],
ViewerOps USING [AddProp, BlinkIcon, CloseViewer, CreateViewer, DestroyViewer, FetchProp, FindViewer, GrowViewer, OpenIcon, PaintViewer, SetMenu, SetNewVersion],
ViewerLocks USING [CallUnderWriteLock],
ViewerSpecs USING [bwScreenHeight, openLeftWidth],
ViewerTools USING [EnableUserEdits, GetSelectedViewer, GetSelectionContents, InhibitUserEdits, SetTiogaContents, TiogaContentsRec, TiogaContents];
BlackCherryImpl:
CEDAR
MONITOR
IMPORTS Atom, BasicTime, BlackCherryInternal, Buttons, Commander, CommanderOps, Containers, FileNames, IO, MailRetrieve, MailSend, Menus, PFS, PFSNames, PopUpSelection, Process, Rope, SendMailOps, TiogaAccess, TiogaAccessViewers, TiogaButtons, TiogaMenuOps, TiogaOps, SystemNames, UserProfile, ViewerEvents, ViewerIO, ViewerOps, ViewerLocks, ViewerSpecs, ViewerTools
EXPORTS BlackCherry, BlackCherryInternal, BlackCherrySidedoor
~ BEGIN OPEN BlackCherry, BlackCherryInternal, BlackCherrySidedoor;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
CantParse: SIGNAL ~ CODE;
Copied Types
Viewer: TYPE ~ ViewerClasses.Viewer;
TiogaButton: TYPE ~ TiogaButtons.TiogaButton;
TiogaContents: TYPE ~ ViewerTools.TiogaContents;
TiogaContentsRec: TYPE ~ ViewerTools.TiogaContentsRec;
Types
RetrieveState:
TYPE ~
ATOM;
{ OK, communicationFailure, noSuchServer, connectionRejected, badCredentials, didNotRespond, noMailboxes, noServers, unknownFailure, unknownError };
Fundamental constants
iconFileName: ROPE ~ "BlackCherry.icons";
interesting parameters
msgSetStyle:
ROPE ¬ "BeginStyle
(cedar) AttachStyle
(header) \"a message header\" {
default
200 pt restIndent
} StyleRule
EndStyle";
Global State
msgSetIcon: PUBLIC ViewerClasses.IconFlavor ¬ tool;
msgIcon: PUBLIC ViewerClasses.IconFlavor ¬ tool;
plainTextStyle: ROPE; -- BlackCherry.PlainTextStyle
showDels: BOOL; -- BlackCherry.ShowDeletedMsgs
tocDefaultLooks: ROPE; -- BlackCherry.TOCDefaultLooks
tocSelectedLooks: ROPE; -- BlackCherry.TOCSelectedLooks
tocUnreadLooks: ROPE; -- BlackCherry.TOCUnreadLooks
deletedLooks: ROPE; -- BlackCherry.DeletedLooks
tocDelAndUnreadLooks: ROPE; -- an optimization!
tsViewerEventRegistration: ViewerEvents.EventRegistration ¬ NIL;
BFSImpl
BadName: PUBLIC ERROR ~ CODE;
OpenFailed:
PUBLIC
ERROR ~
CODE;
fileProcs: FileProcs ¬
NIL;
RegisterFileProcs:
PUBLIC
ENTRY
PROC[procs: FileProcs] = {
fileProcs ¬ procs
};
Logs from other sources
CreateBCMailLogFromStream:
PUBLIC
PROC[fileName:
ROPE, msgProc: MsgFromStreamProc]
RETURNS[ok:
BOOL ¬
FALSE] ~ {
fileData: BCFileData ¬ fileProcs.openOrCreate[fileName, $create
! OpenFailed => { GOTO Failed }];
ok ¬ BCMailLog[fileData, msgProc, NIL];
EXITS
Failed =>
Report[noCreateRope, [rope[fileName]] ];
};
noCreateRope: ROPE ~ "\n*** could not create %g for new BlackCherry mailLog - quitting\n";
CreateBCMailLogFromRopes:
PUBLIC
PROC[fileName:
ROPE, msgProc: MsgFromRopesProc]
RETURNS[ok:
BOOL ¬
FALSE] ~ {
fileData: BCFileData ¬ fileProcs.openOrCreate[fileName, $create
! OpenFailed => { GOTO Failed }];
ok ¬ BCMailLog[fileData, NIL, msgProc];
EXITS
Failed =>
Report[noCreateRope, [rope[fileName]] ];
};
Ops for flushing, etc
StrmFlush:
PUBLIC
PROC[stream:
STREAM, msiData: MsiData] ~ {
IF stream #
NIL
THEN {
stream.Flush[];
msiData.timeOfLastFlush ¬ BasicTime.Now[];
};
};
CheckForFlush:
PROC [msInfo: MsgSetInfo] ~ {
now: BasicTime.GMT = BasicTime.Now[];
ro: REF BOOL ~ NARROW[msInfo.fileData.clientData];
msiData: MsiData ~ NARROW[msInfo.data];
IF ro THEN RETURN;
IF ( BasicTime.Period[from: msiData.timeOfLastFlush, to: now] > 60 )
THEN {
StrmFlush[msInfo.fileData.writeStream, msiData];
StrmFlush[msInfo.fileData.readStream, msiData];
};
};
CloseAndCreate:
PROC [msInfo: MsgSetInfo] ~ {
IF ( msInfo.fileData.writeStream #
NIL )
THEN {
msiData: MsiData ~ NARROW[msInfo.data];
StrmFlush[msInfo.fileData.writeStream, msiData];
msInfo.fileData.writeStream.Close[];
};
IF ( msInfo.fileData.readStream # NIL ) AND ( msInfo.fileData.readStream # msInfo.fileData.writeStream ) THEN msInfo.fileData.readStream.Close[ ! IO.Error => CONTINUE];
msInfo.fileData ¬ fileProcs.openOrCreate[msInfo.fileName, $create];
};
CloseAndOpen:
PUBLIC
PROC [msInfo: MsgSetInfo] ~ {
now: BasicTime.GMT = BasicTime.Now[];
ro: REF BOOL ~ NARROW[msInfo.fileData.clientData];
IF ( msInfo.fileData.writeStream #
NIL )
THEN {
msiData: MsiData ~ NARROW[msInfo.data];
StrmFlush[msInfo.fileData.writeStream, msiData];
msInfo.fileData.writeStream.Close[];
};
IF ( msInfo.fileData.readStream # NIL ) AND ( msInfo.fileData.readStream # msInfo.fileData.writeStream ) THEN msInfo.fileData.readStream.Close[ ! IO.Error => CONTINUE];
msInfo.fileData ¬ fileProcs.openOrCreate[msInfo.fileName, IF ro THEN $openRO ELSE $open];
};
SetFileLength:
PUBLIC
PROC [msInfo: MsgSetInfo, len:
INT] ~ {
ro: REF BOOL ~ NARROW[msInfo.fileData.clientData];
IF ro THEN RETURN;
msInfo.fileData.writeStream.SetIndex[len];
msInfo.fileData.writeStream.Close[];
IF ( msInfo.fileData.readStream # msInfo.fileData.writeStream ) THEN msInfo.fileData.readStream.Close[ ! IO.Error => CONTINUE];
fileProcs.setByteCount[msInfo.fileData, len];
msInfo.fileData ¬ fileProcs.openOrCreate[msInfo.fileName, $open];
};
Useful stuff
GetRetrieveHandle:
PUBLIC
PROC
RETURNS[RetrieveHandle] ~ {
RETURN[curRH] };
have to be careful calling between BlackCherryImpl and BlackCherryMailImpl
GetRH: ENTRY PROC RETURNS[RetrieveHandle] ~ { RETURN[curRH] };
PathInHomeDirectory:
PROC [ shortName:
ROPE ]
RETURNS [ path:
ROPE ] ~ {
user: ROPE ← UserCredentials.Get[].name; -- need Unix name here
IF simpleUserNameList # NIL THEN user ← simpleUserNameList.first
ELSE user ← UserCredentials.Get[].name;
path ¬ Rope.Concat[SystemNames.SimpleHomeDirectory[], shortName];
};
CaptionName:
PROC[fileName:
ROPE]
RETURNS [
ROPE] =
{ RETURN[Rope.Concat["Messages on ", fileName] ] };
Command(s)
Blackie: Commander.CommandProc ~ {
IF ( msgSetIcon = tool ) AND ( fileProcs # NIL ) THEN fileProcs.iconSetter[iconFileName];
{
wDir: ROPE ~ FileNames.CurrentWorkingDirectory[];
fileName: ROPE;
doMail: BOOL ¬ TRUE;
readOnly: BOOL ¬ FALSE;
msiData: MsiData ¬ NEW[MsiDataRec];
msiData.okToFlushMail ¬ UserProfile.Boolean["BlackCherry.okToFlushMail", TRUE];
msiData.allowNewMail ¬ CheckForNewMailAllowed[];
debugging ¬ FALSE; -- reset each time
FOR this:
ROPE ¬ CommanderOps.NextArgument[cmd], CommanderOps.NextArgument[cmd]
UNTIL this =
NIL
DO
SELECT
TRUE
FROM
( this.Length[] < 2 ) => { NULL }; -- can't be a switch or fileName
( this.Fetch[0] # '- ) => { fileName ¬ this }; -- can't be a switch
ENDCASE => {
SELECT this.Fetch[1]
FROM
'c, 'C => { msiData.checkStateReporting ¬ TRUE };
'd, 'D => { msiData.okToFlushMail ¬ FALSE };
'f, 'F => { msiData.okToFlushMail ¬ TRUE };
'n, 'N => { doMail ¬ FALSE };
'r, 'R =>
{ readOnly ¬ TRUE; doMail ¬ FALSE; msiData.allowNewMail ¬ FALSE };
'x, 'X => { debugging ¬ TRUE };
'z, 'Z => { doMail ¬ FALSE; msiData.allowNewMail ¬ FALSE };
ENDCASE => { NULL };
};
ENDLOOP;
IF NOT msiData.allowNewMail THEN doMail ¬ FALSE;
IF doMail THEN { [] ¬ UpdateUser[msiData]; CreateAlertButton[]; };
IF ( fileName =
NIL )
THEN fileName ¬ UserProfile.Token[key: "BlackCherry.MailLog", default: NIL];
IF ( fileName =
NIL )
THEN fileName ¬ PathInHomeDirectory["BlackCherry.mailLog"];
{
old: STREAM ¬ reportStrm;
reportStrm ¬ TSStream["BlackCherry"];
IF old #
NIL
THEN {
IF debugging THEN reportStrm.PutF1["\n\t unregister old: %g\n", [integer[LOOPHOLE[old]]] ];
SendMailOps.UnregisterReporter[old];
};
SendMailOps.RegisterReporter[reportStrm];
};
IF debugging THEN
reportStrm.PutF1["\n\t register reportStrm: %g\n", [integer[LOOPHOLE[reportStrm]]] ];
fileName ¬ fileProcs.fullName[fileName, wDir ! BadName => { GOTO Failed }];
{
oldV: Viewer;
IF (oldV ¬ ViewerOps.FindViewer[CaptionName[fileName]]) #
NIL
THEN {
ViewerOps.BlinkIcon[oldV];
Report["\n*** BlackCherry is already looking at %g\n", [rope[fileName]] ];
RETURN
};
};
{
msInfo: MsgSetInfo ¬ NEW[MsgSetInfoRec];
msInfo.data ¬ msiData;
IF readOnly
THEN msInfo.whichMenu ¬ $readOnly
ELSE IF NOT msiData.allowNewMail THEN msInfo.whichMenu ¬ $dontAllowNewMail;
CheckForFlushMsgs[msiData];
plainTextStyle ¬ UserProfile.Token[key: "BlackCherry.PlainTextStyle", default: "cedar"];
showDels ¬ UserProfile.Boolean[key: "BlackCherry.ShowDeletedMsgs", default: FALSE];
tocDefaultLooks ¬ UserProfile.Token[key: "BlackCherry.TOCDefaultLooks", default: ""];
tocSelectedLooks ¬ UserProfile.Token[key: "BlackCherry.TOCSelectedLooks", default: "sb"];
tocUnreadLooks ¬ UserProfile.Token[key: "BlackCherry.TOCUnreadLooks", default: "i"];
msiData.useFromFieldInTOC ¬ UserProfile.Boolean[key: "BlackCherry.UseFromFieldInTOC", default: FALSE];
deletedLooks ¬ UserProfile.Token[key: "BlackCherry.DeletedLooks", default: "y"];
tocDelAndUnreadLooks ¬ deletedLooks.Concat[tocUnreadLooks];
msInfo.fileData ¬ fileProcs.openOrCreate[fileName, IF readOnly THEN $openRO ELSE $openOrCreate
! OpenFailed => { GOTO Failed }];
msInfo.fileName ¬ fileName;
AddToMsInfoList[msInfo];
TRUSTED
{ Process.Detach[FORK StartBlackCherryRead[msInfo, doMail, readOnly]] };
};
};
EXITS
Failed => { result ¬ $Failure };
};
StartBlackCherryRead:
ENTRY
PROC [msInfo: MsgSetInfo, readNewNow, readOnly:
BOOL] ~ {
ENABLE
UNWIND => {
IF ( msInfo.fileData.writeStream # NIL ) THEN msInfo.fileData.writeStream.Close[ ! IO.Error => CONTINUE];
IF ( msInfo.fileData.readStream # NIL ) THEN msInfo.fileData.readStream.Close[ ! IO.Error => CONTINUE];
IF ( msInfo.viewer # NIL ) THEN msInfo.viewer.inhibitDestroy ¬ FALSE;
};
caption: ROPE ~ CaptionName[msInfo.fileName];
label: ROPE ~ FileNames.GetShortName[msInfo.fileName];
numUndel, totalMsgs: INT;
v: Viewer;
msiData: MsiData ~ NARROW[msInfo.data];
menuToUse: Menus.Menu ¬
IF readOnly
THEN readOnlyMenu
ELSE IF NOT msiData.allowNewMail THEN dontAllowNewMailMenu ELSE displayerMenu;
ok: BOOL ¬ FALSE;
column: ViewerClasses.Column ¬ left;
WhichCol:
PROC[rp:
ROPE, df: ViewerClasses.Column]
RETURNS[ViewerClasses.Column] = {
SELECT
TRUE
FROM
rp.Equal["left", FALSE] => RETURN[left];
rp.Equal["right", FALSE] => RETURN[right];
rp.Equal["color", FALSE] => RETURN[color];
ENDCASE => RETURN[df];
};
columnRope: ROPE ¬ UserProfile.Token[key: "BlackCherry.MsgSetColumn", default: "right"];
column ¬ WhichCol[columnRope, right];
Report["\n\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~ %g\n", [time[BasicTime.Now[]]] ];
Report["\tUsing BlackCherry file %g\n", [rope[msInfo.fileName]] ];
BEGIN
ENABLE
BEGIN
PFS.Error => {
Report["\n*** PFS.Error during ReadBWFile: %g\n", [rope[error.explanation]] ];
CONTINUE
};
IO.Error => {
Report["\n*** IO.Error during ReadBWFile: %g\n", [integer[ORD[ec]]] ];
CONTINUE;
};
END;
numUndel ¬ - 1;
[numUndel, totalMsgs, ok] ¬ ReadBWFile[msInfo];
IF
NOT ok
THEN {
readNewNow ¬ FALSE;
menuToUse ¬ readOnlyMenu;
msInfo.whichMenu ¬ $readOnly;
};
END;
InfoMsg[numUndel, totalMsgs, msInfo.fileData.readStream];
IF ( readNewNow ) THEN ReadAnyNewMail[msInfo];
v ¬ msInfo.viewer ¬ ViewerOps.CreateViewer[flavor: $Container, info: [name: caption, label: label, menu: menuToUse, iconic: TRUE, icon: msgSetIcon, column: column, scrollable: FALSE, inhibitDestroy: TRUE] ];
msInfo.destroyER ¬ ViewerEvents.RegisterEventProc[DestroyMSViewer, destroy, v, TRUE];
msInfo.tiogaViewer ¬ TiogaButtons.CreateViewer[info: [parent: v, border: FALSE, ww: ViewerSpecs.openLeftWidth, wh: ViewerSpecs.bwScreenHeight]];
TiogaButtons.SetStyleFromRope[v: msInfo.tiogaViewer, styleRope: msgSetStyle];
Containers.ChildXBound[v, msInfo.tiogaViewer];
Containers.ChildYBound[v, msInfo.tiogaViewer];
ViewerOps.AddProp[v, $BlackCherry, msInfo];
IF ( msInfo.first # NIL ) THEN AddMsgs[msInfo, showDels];
IF v.iconic THEN ViewerOps.OpenIcon[v];
v.inhibitDestroy ¬ FALSE;
msiData.timeOfLastFlush ¬ BasicTime.Now[];
IF msiData.allowNewMail THEN TRUSTED { Process.Detach[FORK CheckState[]] };
};
CheckState:
PROC ~ {
p: NAT ~ NewP[];
last: MailRetrieve.MBXState;
mSeconds: INT ~ 30000; -- 30 sec
curMH: RetrieveHandle ¬ GetRH[];
count: CARD ¬ 0;
csReporting: BOOL;
IF ( curMH = NIL ) OR ( newMailAlertButton = NIL ) THEN RETURN;
IF ( csReporting ¬ curMH.msiData.checkStateReporting ) THEN
Report["==> CheckState: p = %g\n", [cardinal[p]] ];
last ¬ curMH.lastStateReported;
Buttons.SetDisplayStyle[button: newMailAlertButton, style: $BlackOnGrey];
WHILE ( p = CurrentP[] )
--Abort earlier processes as new ones enter--
DO
new: MailRetrieve.MBXState;
curMH: RetrieveHandle ¬ GetRH[];
IF curMH =
NIL
THEN {
IF csReporting THEN Report["==> Exiting CheckState (curMH=NIL): p = %g, count = %g\n", [cardinal[p]], [cardinal[count]] ];
RETURN;
};
IF csReporting THEN IF ( count = 50 )
THEN Report["==> in loop: p = %g\n", [cardinal[p]] ];
count ¬ count.SUCC;
new ¬ curMH.lastStateReported;
SELECT new
FROM
badName, badPwd, cantAuth, allDown => {
Buttons.SetDisplayStyle[newMailAlertButton, $BlackOnGrey];
};
unknown => {
Buttons.SetDisplayStyle[newMailAlertButton, $BlackOnGrey];
};
allEmpty => {
Buttons.SetDisplayStyle[newMailAlertButton, $BlackOnWhite];
};
notEmpty => {
Buttons.SetDisplayStyle[newMailAlertButton, $WhiteOnBlack];
};
userOK, someEmpty => { NULL };
ENDCASE => { ERROR };
Process.PauseMsec[mSeconds]
ENDLOOP;
IF csReporting THEN Report["==> Exiting CheckState: p = %g, count = %g\n", [cardinal[p]], [cardinal[count]] ];
};
ForceStateOff:
PUBLIC
PROC = {
p: NAT ~ NewP[];
curMH: RetrieveHandle ¬ GetRH[];
IF ( curMH = NIL ) OR ( newMailAlertButton = NIL ) THEN RETURN;
IF curMH.msiData.checkStateReporting THEN
Report["==> In ForceStateOff, p = %g\n", [cardinal[p]] ];
curMH.lastStateReported ¬ allEmpty;
Buttons.SetDisplayStyle[newMailAlertButton, $BlackOnWhite];
TRUSTED { Process.Detach[FORK CheckState[]] };
};
Menus
blankMenu: Menus.Menu ¬ Menus.CreateMenu[];
displayerMenu: Menus.Menu ¬ Menus.CreateMenu[];
readOnlyMenu: Menus.Menu ¬ Menus.CreateMenu[];
dontAllowNewMailMenu: Menus.Menu ¬ Menus.CreateMenu[];
frozenMsgMenu: Menus.Menu ¬ Menus.CreateMenu[];
msgMenu: Menus.Menu ¬ Menus.CreateMenu[];
CreateMenus:
PROC ~ {
displayerMenu
Menus.AppendMenuEntry[displayerMenu,
Menus.CreateEntry["ShowUndelOnly", ShowUndelOnlyProc]];
Menus.AppendMenuEntry[displayerMenu,
Menus.CreateEntry["Display", DisplayProc]];
Menus.AppendMenuEntry[displayerMenu,
Menus.CreateEntry["Delete", DeleteProc]];
Menus.AppendMenuEntry[displayerMenu,
Menus.CreateEntry["NewMail", NewMailProc]];
Menus.AppendMenuEntry[displayerMenu,
Menus.CreateEntry["Find", FindProc]];
Menus.AppendMenuEntry[displayerMenu,
Menus.CreateEntry["Ops", OpsMenuProc]];
dontAllowNewMailMenu
Menus.AppendMenuEntry[dontAllowNewMailMenu,
Menus.CreateEntry["ShowUndelOnly", ShowUndelOnlyProc]];
Menus.AppendMenuEntry[dontAllowNewMailMenu,
Menus.CreateEntry["Display", DisplayProc]];
Menus.AppendMenuEntry[dontAllowNewMailMenu,
Menus.CreateEntry["Delete", DeleteProc]];
Menus.AppendMenuEntry[dontAllowNewMailMenu,
Menus.CreateEntry["Find", FindProc]];
Menus.AppendMenuEntry[dontAllowNewMailMenu,
Menus.CreateEntry["Ops", OpsMenuProc]];
opsProcs
AddOpsProc["Sender", CreateSendViewerProc, $all];
AddOpsProc["MsgNumInfo", MsgNumInfoProc, $all];
AddOpsProc["ShowAll", ShowAllProc, $all];
AddOpsProc["MsgID", MsgIDProc, $all];
AddOpsProc["NewLogFile", NewFile, $writeNeeded];
AddOpsProc["Expunge", ExpungeProc, $writeNeeded];
AddOpsProc["Expunge&Sort", SortProc, $writeNeeded];
AddOpsProc["NSToTioga", NSToTioga, $all];
AddOpsProc["TiogaToNS", TiogaToNS, $all];
AddOpsProc["CloseAll", CloseAllProc, $all];
AddOpsProc["AppendMsg", AppendMsgProc, $writeNeeded];
readOnlyMenu
Menus.AppendMenuEntry[readOnlyMenu,
Menus.CreateEntry["ShowUndelOnly", ShowUndelOnlyProc]];
Menus.AppendMenuEntry[readOnlyMenu,
Menus.CreateEntry["Display", DisplayProc]];
Menus.AppendMenuEntry[readOnlyMenu,
Menus.CreateEntry["Find", FindProc]];
Menus.AppendMenuEntry[readOnlyMenu,
Menus.CreateEntry["Ops", OpsMenuProc]];
frozenMsgMenu
FOR procs:
LIST
OF MailSend.MailSendProcsRef ¬ MailSend.GetRegisteredSendProcsList[],
procs.rest
UNTIL procs =
NIL
DO
name: ROPE ¬ Rope.Concat[Atom.GetPName[procs.first.which], "Answer"];
Menus.AppendMenuEntry[frozenMsgMenu,
Menus.CreateEntry[name: name, proc: MsgAnswerProc, clientData: procs.first.which]];
ENDLOOP;
Menus.AppendMenuEntry[frozenMsgMenu,
Menus.CreateEntry["Forward", MsgForwardProc]];
Menus.AppendMenuEntry[frozenMsgMenu,
Menus.CreateEntry["ReSend", MsgReSendProc]];
Menus.AppendMenuEntry[frozenMsgMenu,
Menus.CreateEntry["Find", MsgFindProc]];
Menus.AppendMenuEntry[frozenMsgMenu,
Menus.CreateEntry["", MsgActivityProc]];
Menus.AppendMenuEntry[frozenMsgMenu,
Menus.CreateEntry["NSToTioga", NSToTiogaProc]];
Menus.AppendMenuEntry[frozenMsgMenu,
Menus.CreateEntry["TiogaToNS", TiogaToNSProc]];
msgMenu
Menus.AppendMenuEntry[msgMenu,
Menus.CreateEntry["Freeze", MsgFreezeProc]];
FOR procs:
LIST
OF MailSend.MailSendProcsRef ¬ MailSend.GetRegisteredSendProcsList[],
procs.rest
UNTIL procs =
NIL
DO
name: ROPE ¬ Rope.Concat[Atom.GetPName[procs.first.which], "Answer"];
Menus.AppendMenuEntry[msgMenu,
Menus.CreateEntry[name: name, proc: MsgAnswerProc, clientData: procs.first.which]];
ENDLOOP;
Menus.AppendMenuEntry[msgMenu,
Menus.CreateEntry["Forward", MsgForwardProc]];
Menus.AppendMenuEntry[msgMenu,
Menus.CreateEntry["ReSend", MsgReSendProc]];
Menus.AppendMenuEntry[msgMenu,
Menus.CreateEntry["Find", MsgFindProc]];
Menus.AppendMenuEntry[msgMenu,
Menus.CreateEntry["", MsgActivityProc]];
Menus.AppendMenuEntry[msgMenu,
Menus.CreateEntry["NSToTioga", NSToTiogaProc]];
Menus.AppendMenuEntry[msgMenu,
Menus.CreateEntry["TiogaToNS", TiogaToNSProc]];
};
AddDisplayerProc:
PUBLIC PROC[menuName:
ROPE, proc: Menus.MenuProc] ~ {
Add item to main per-msgSet menu.
Menus.AppendMenuEntry[displayerMenu,
Menus.CreateEntry[menuName, proc]];
};
AddMsgProc:
PUBLIC PROC[menuName:
ROPE, proc: Menus.MenuProc] ~ {
Add item to main per-msg menu.
Menus.AppendMenuEntry[msgMenu,
Menus.CreateEntry[menuName, proc]];
};
MenuProc's (frozen/msg)
MsgFreezeProc: Menus.MenuProc ~ {
self: Viewer ~ NARROW[parent];
frozen: Menus.MenuEntry ~ Menus.FindEntry[self.menu, "Freeze"];
msVInfo: MsgSetInfo;
IF ( frozen = NIL ) THEN RETURN;
msVInfo ¬ NARROW[ViewerOps.FetchProp[parent, $BlackCherry]];
ViewerOps.AddProp[ self, $Frozen, self ];
ViewerOps.SetMenu[self, frozenMsgMenu];
IF msVInfo.msgDisplayer = self THEN msVInfo.msgDisplayer ¬ NIL;
MsgAnswerProc: Menus.MenuProc ~ {
OPEN TiogaOps;
self: Viewer ¬ NARROW[parent];
transport: ATOM ¬ NARROW[clientData];
ans: Viewer;
msgR: ROPE;
self.inhibitDestroy ¬ TRUE;
TRUSTED { msgR ¬ SendMailOps.CreateRopeForTextNode[LOOPHOLE[ViewerDoc[self]]]};
ans ¬ SendMailOps.Answer[msgR, self, transport];
IF ( ( UserProfile.Boolean["BlackCherry.EditedAnswerSenders", FALSE] )
OR ( mouseButton = blue ) ) THEN ViewerOps.SetNewVersion[ans];
self.inhibitDestroy ¬ FALSE;
MsgReSendProc: Menus.MenuProc ~ {
self: Viewer ¬ NARROW[parent];
self.inhibitDestroy ¬ TRUE;
[] ¬ SendMailOps.ReSend[self, self];
self.inhibitDestroy ¬ FALSE;
};
MsgForwardProc: Menus.MenuProc ~ {
self: Viewer ¬ NARROW[parent];
fw: Viewer;
self.inhibitDestroy ¬ TRUE;
fw ¬ SendMailOps.Forward[self, self];
IF ( ( UserProfile.Boolean["BlackCherry.EditedForwardSenders", FALSE] )
OR ( mouseButton = blue ) ) THEN ViewerOps.SetNewVersion[fw];
self.inhibitDestroy ¬ FALSE;
};
MsgFindProc: Menus.MenuProc ~ {
self: Viewer = NARROW[parent];
sd: TiogaOps.SearchDir ¬
SELECT mouseButton
FROM
red => forwards,
yellow => anywhere,
blue => backwards,
ENDCASE => forwards;
IF ( NOT TiogaOps.FindText[viewer: self, whichDir: sd, which: feedback, case: NOT shift] ) THEN ViewerOps.BlinkIcon[self];
};
MsgActivityProc: Menus.MenuProc ~ {
self: Viewer = NARROW[parent];
SELECT mouseButton
FROM
red => self.transparentTIP ¬ TRUE;
ENDCASE => self.transparentTIP ¬ FALSE;
};
PutChar:
PROC[
output: TiogaAccess.Writer,
inChar: TiogaAccess.TiogaChar,
charSet: TiogaAccess.CharSet]
RETURNS[char: TiogaAccess.TiogaChar] = {
char ¬ inChar;
IF charSet # 0 THEN char.charSet ¬ charSet;
IF char.charSet # 0 THEN char.looks['j] ¬ TRUE;
TiogaAccess.Put[output, char];
};
NSToTiogaProc:
ENTRY Menus.MenuProc = {
self: Viewer = NARROW[parent];
input: TiogaAccess.Reader ¬ TiogaAccessViewers.FromViewer[self];
output: TiogaAccess.Writer ¬ TiogaAccess.Create[];
DoNSToTiogaProc[input, output];
ViewerTools.EnableUserEdits[self];
TiogaAccessViewers.WriteViewer[output, self];
ViewerTools.InhibitUserEdits[self];
};
DoNSToTiogaProc:
INTERNAL
PROC[input: TiogaAccess.Reader, output: TiogaAccess.Writer] = {
State: TYPE = {normal, xns, esc, escdol, jis, jis2nd, jisesc, jisescpar};
char, escChar, postChar: TiogaAccess.TiogaChar ¬
TiogaAccess.TiogaChar[0, '\000, ALL[FALSE], NIL, FALSE, FALSE, 1, NIL];
charSet: TiogaAccess.CharSet ¬ 0;
state: State ¬ State.normal;
UNTIL input.EndOf[]
DO
char ¬ input.Get[];
SELECT state
FROM
State.normal => {
IF char.char = '\377 THEN state ¬ State.xns
ELSE IF char.char = '\033 THEN {state ¬ State.esc; escChar ¬ char;}
ELSE [] ¬ PutChar[output, char, charSet];
};
State.xns => {state ¬ State.normal; charSet ¬ ORD[char.char];};
State.esc => {
IF char.char = '$ THEN {state ¬ State.escdol; postChar ¬ char;}
ELSE {state ¬ State.normal; [] ¬ PutChar[output, escChar, charSet]};
};
State.escdol => {
IF char.char = '@ THEN state ¬ State.jis
ELSE {
state ¬ State.normal;
[] ¬ PutChar[output, escChar, charSet];
[] ¬ PutChar[output, postChar, charSet];
};
};
State.jis => {
IF char.char = '\033 THEN {state ¬ State.jisesc; escChar ¬ char;}
ELSE {state ¬ State.jis2nd; charSet ¬ ORD[char.char];};
};
State.jis2nd => {state ¬ State.jis; [] ¬ PutChar[output, char, charSet];};
State.jisesc => {
IF char.char = '( THEN {state ¬ State.jisescpar; postChar ¬ char;}
ELSE {state ¬ State.jis; [] ¬ PutChar[output, escChar, 0];}
};
State.jisescpar => {
IF char.char = 'H OR char.char = 'J THEN {state ¬ State.normal; charSet ¬ 0;}
ELSE {
state ¬ State.jis;
[] ¬ PutChar[output, escChar, 0];
[] ¬ PutChar[output, postChar, 0];
};
};
ENDCASE => ERROR;
ENDLOOP;
TiogaAccess.DoneWith[input];
};
TiogaToNSProc:
ENTRY Menus.MenuProc ~ {
self: Viewer = NARROW[parent];
input: TiogaAccess.Reader ¬ TiogaAccessViewers.FromViewer[self];
output: TiogaAccess.Writer ¬ TiogaAccess.Create[];
DoTiogaToNSProc[input, output];
ViewerTools.EnableUserEdits[self];
TiogaAccessViewers.WriteViewer[output, self];
ViewerTools.InhibitUserEdits[self];
};
DoTiogaToNSProc:
INTERNAL
PROC[input: TiogaAccess.Reader, output: TiogaAccess.Writer] = {
char, ffChar, charSet: TiogaAccess.TiogaChar ¬
TiogaAccess.TiogaChar[0, '\000, ALL[FALSE], NIL, FALSE, FALSE, 1, NIL];
curCharSet: TiogaAccess.CharSet ¬ 0;
ffChar.char ¬ '\377;
UNTIL input.EndOf[]
DO
char ¬ input.Get[];
IF char.charSet # curCharSet
THEN {
charSet.char ¬ VAL[curCharSet ¬ char.charSet];
TiogaAccess.Put[output, ffChar];
TiogaAccess.Put[output, charSet];
};
char.charSet ¬ 0;
char.looks['j] ¬ FALSE;
TiogaAccess.Put[output, char]
ENDLOOP;
TiogaAccess.DoneWith[input];
};
MenuProc's (displayer)
noSelDisp: ROPE ~ " No selected msg to be displayed\n";
ShowUndelOnlyProc:
ENTRY Menus.MenuProc ~ {
ENABLE UNWIND => NULL;
msInfo: MsgSetInfo ~ NARROW[ViewerOps.FetchProp[parent, $BlackCherry]];
FOR msgH: MsgHandle ¬ msInfo.first, msgH.next
WHILE
( msgH #
NIL )
DO
IF ( NOT msgH.deleted ) THEN LOOP;
TiogaButtons.DeleteButton[msgH.tocButton];
msgH.tocButton ¬ NIL;
ENDLOOP;
IF ( msInfo.selected # NIL ) THEN IF ( msInfo.selected.tocButton = NIL ) THEN msInfo.selected ¬ NIL;
};
DisplayProc:
ENTRY Menus.MenuProc ~ {
ENABLE UNWIND => NULL;
msInfo: MsgSetInfo ~ NARROW[ViewerOps.FetchProp[parent, $BlackCherry]];
selected: MsgHandle;
IF ( msInfo = NIL ) THEN RETURN;
selected ¬ msInfo.selected;
IF ( selected = NIL ) THEN { Report[noSelDisp]; RETURN };
IF ( mouseButton # red ) THEN selected ¬ AdvanceSelection[selected];
IF ( selected = NIL )
THEN Report[noSelDisp]
ELSE DisplayOneMsg[msInfo.selected ¬ selected, shift]
};
DeleteProc:
ENTRY Menus.MenuProc ~ {
ENABLE UNWIND => NULL;
msInfo: MsgSetInfo ~ NARROW[ViewerOps.FetchProp[parent, $BlackCherry]];
selected: MsgHandle;
IF ( msInfo = NIL ) THEN RETURN;
selected ¬ msInfo.selected;
IF ( selected = NIL )
THEN { Report[" No selected msg to be deleted\n"]; RETURN };
ShowAsDeleted[selected];
selected ¬ AdvanceSelection[selected];
IF ( mouseButton # red )
THEN {
IF ( selected = NIL )
THEN Report[noSelDisp]
ELSE DisplayOneMsg[msInfo.selected ¬ selected, shift]
};
};
NewMailProc:
ENTRY Menus.MenuProc ~ {
ENABLE UNWIND => NULL;
msInfo: MsgSetInfo ~ NARROW[ViewerOps.FetchProp[parent, $BlackCherry]];
ReadAnyNewMail[msInfo];
AddMsgs[msInfo, showDels];
};
FindProc: Menus.MenuProc ~ {
msViewer: Viewer ~ NARROW[parent];
msInfo: MsgSetInfo ~ NARROW[ViewerOps.FetchProp[parent, $BlackCherry]];
sd: TiogaOps.SearchDir ~
SELECT mouseButton
FROM
red => forwards,
yellow => anywhere,
blue => backwards,
ENDCASE => forwards;
IF ( msInfo = NIL ) THEN RETURN;
IF ( NOT TiogaOps.FindText[viewer: msInfo.tiogaViewer, whichDir: sd, which: feedback, case: NOT shift] ) THEN ViewerOps.BlinkIcon[msViewer];
};
allPopUpFormsList: LIST OF ROPE ¬ NIL;
roPopUpFormsList: LIST OF ROPE ¬ NIL;
allOpsProcsList: LIST OF OpsProc ¬ NIL;
roOpsProcsList: LIST OF OpsProc ¬ NIL;
OpsMenuProc: Menus.MenuProc ~ {
ENABLE UNWIND => NULL;
viewer: Viewer ~ NARROW[parent];
msInfo: MsgSetInfo ~ NARROW[ViewerOps.FetchProp[viewer, $BlackCherry]];
procList: LIST OF OpsProc ¬ IF msInfo.whichMenu = $readOnly THEN roOpsProcsList ELSE allOpsProcsList;
which: INT;
which ¬ PopUpSelection.Request["Ops", IF msInfo.whichMenu = $readOnly THEN roPopUpFormsList ELSE allPopUpFormsList];
IF which <= 0 THEN RETURN; -- no selection
FOR i:
INT
IN [1..which)
DO
IF procList = NIL THEN RETURN;
procList ¬ procList.rest;
ENDLOOP;
IF procList #
NIL
THEN
procList.first[msInfo];
};
AddOpsProc:
PUBLIC ENTRY PROC[menuName:
ROPE, proc: OpsProc, whichMenu:
ATOM ¬ $all] ~ {
Add item to "Ops" menu that invokes the given procedure when buttoned. Note: there is a one-to-one correspondence between items on the popUpFormsList and the opsProcsList.
ENABLE UNWIND => NULL;
IF whichMenu # $writeNeeded
THEN {
IF roOpsProcsList =
NIL
THEN roOpsProcsList ¬
LIST[proc]
ELSE {
procList: LIST OF OpsProc ¬ roOpsProcsList;
UNTIL procList.rest = NIL DO procList ¬ procList.rest; ENDLOOP;
procList.rest ¬ LIST[proc];
};
IF roPopUpFormsList =
NIL
THEN roPopUpFormsList ¬
LIST[menuName]
ELSE {
rL: LIST OF ROPE ¬ roPopUpFormsList;
UNTIL rL.rest = NIL DO rL ¬ rL.rest; ENDLOOP;
rL.rest ¬ LIST[menuName];
};
};
add it to all the menus
IF allOpsProcsList =
NIL
THEN allOpsProcsList ¬
LIST[proc]
ELSE {
procList: LIST OF OpsProc ¬ allOpsProcsList;
UNTIL procList.rest = NIL DO procList ¬ procList.rest; ENDLOOP;
procList.rest ¬ LIST[proc];
};
IF allPopUpFormsList =
NIL
THEN allPopUpFormsList ¬
LIST[menuName]
ELSE {
rL: LIST OF ROPE ¬ allPopUpFormsList;
UNTIL rL.rest = NIL DO rL ¬ rL.rest; ENDLOOP;
rL.rest ¬ LIST[menuName];
};
};
"Ops" pop-up methods
CreateSendViewerProc:
INTERNAL
PROC [msInfo: MsgSetInfo] ~ {
[] ¬ SendMailOps.CreateSendViewer[fromExec: FALSE];
};
MsgNumInfoProc:
INTERNAL
PROC [msInfo: MsgSetInfo] ~ {
undel: INT ¬ 0; total: INT ¬ 0;
FOR msgH: MsgHandle ¬ msInfo.first, msgH.next
WHILE ( msgH #
NIL )
DO
IF ( NOT msgH.deleted ) THEN undel ¬ undel.SUCC;
total ¬ total.SUCC;
ENDLOOP;
InfoMsg[undel, total, msInfo.fileData.readStream];
};
InfoMsg:
PROC[undel, total:
INT, stream:
STREAM] = {
kBytes: INT ~ ( stream.GetLength[] + 1023 ) / 1024;
Report["\nThere are %g undeleted msgs (%g total); file is %g kBytes\n",
[integer[undel]], [integer[total]], [integer[kBytes]] ];
};
ShowAllProc:
INTERNAL
PROC [msInfo: MsgSetInfo] ~ {
selected: MsgHandle ~ msInfo.selected;
ClearDisplayer[msInfo];
AddMsgs[msInfo, TRUE];
IF ( selected # NIL ) THEN TiogaButtons.ChangeButtonLooks[button: selected.tocButton, addLooks: tocSelectedLooks];
};
MsgIDProc:
INTERNAL
PROC [msInfo: MsgSetInfo] ~ {
read: IO.STREAM ~ msInfo.fileData.readStream;
sel: MsgHandle ~ msInfo.selected;
IF ( sel = NIL ) THEN { Report["\nNo selected msg\n"]; RETURN };
IF ( sel.gvID = NIL ) THEN sel.gvID ¬ GetMsgID[msInfo, sel];
Report["\ngvID is: %g\n", [rope[sel.gvID]] ];
};
NewFile:
PUBLIC
PROC [msInfo: MsgSetInfo] ~ {
ClearDisplayer[msInfo];
msInfo.first ¬ msInfo.last ¬ msInfo.selected ¬ NIL;
CloseAndCreate[msInfo];
Report["\n\t NewLogFile %g\n", [rope[msInfo.fileName]] ];
};
SortProc:
INTERNAL
PROC [msInfo: MsgSetInfo] ~ {
ExpungeInternal[msInfo, TRUE];
};
ExpungeProc:
INTERNAL
PROC [msInfo: MsgSetInfo] ~ {
ExpungeInternal[msInfo, FALSE];
};
ExpungeInternal:
INTERNAL
PROC [msInfo: MsgSetInfo, sortem:
BOOL] ~ {
ENABLE
PFS.Error => {
Report["\n*** PFS.Error during expunge (%g)\n", [rope[error.explanation]] ];
GOTO didnt;
};
newList, newLast: MsgHandle;
newLogName: ROPE;
kbytes: INT;
which: ROPE ¬ "Renamed";
Report["\n*** Starting Expunge @ %g\n\t", [time[BasicTime.Now[]]] ];
MsgNumInfoProc[msInfo];
ClearDisplayer[msInfo];
[newList, newLast, newLogName] ¬ CopyOrExpunge[msInfo, sortem];
IF ( msInfo.fileData.writeStream # NIL ) THEN msInfo.fileData.writeStream.Close[];
IF ( msInfo.fileData.readStream # NIL ) AND ( msInfo.fileData.readStream # msInfo.fileData.writeStream ) THEN msInfo.fileData.readStream.Close[];
msInfo.fileData.readStream ¬ msInfo.fileData.writeStream ¬ NIL;
BEGIN
PFS.Rename[from: PFS.PathFromRope[newLogName],
to: PFSNames.StripVersionNumber[PFS.PathFromRope[msInfo.fileData.name]] ! PFS.Error => GOTO tryCopy];
EXITS tryCopy => {
PFS.Copy[from: PFS.PathFromRope[newLogName],
to: PFSNames.StripVersionNumber[PFS.PathFromRope[msInfo.fileData.name]],
confirmProc: NIL];
which ¬ "Copied";
};
END;
msInfo.fileData ¬ fileProcs.openOrCreate[FileNames.StripVersionNumber[msInfo.fileData.name], $open
! OpenFailed => { GOTO Failed }];
kbytes ¬ ( msInfo.fileData.writeStream.GetLength[] + 1023 )/1024;
Report["%g ", [rope[which]] ];
Report["%g to %g (%g kbytes)\n", [rope[newLogName]],
[rope[msInfo.fileData.name]], [integer[kbytes]] ];
msInfo.first ¬ newList;
msInfo.last ¬ newLast;
msInfo.selected ¬ NIL;
AddMsgs[msInfo, showDels];
IF sortem
THEN Report["\n\t Expunge & Sort complete\n"]
ELSE Report["\n\t Expunge complete\n"];
EXITS
Failed => Report["\n*** Could not open %g after expunge and rename\n",
[rope[msInfo.fileData.name]] ];
didnt => NULL;
};
CopyOrExpunge:
INTERNAL
PROC [msInfo: MsgSetInfo, sortem:
BOOL]
RETURNS[newList, newLast: MsgHandle ¬
NIL, logName:
ROPE]~ {
ENABLE UNWIND => { ViewerOps.SetMenu[msInfo.viewer, displayerMenu] };
viewer: Viewer ¬ msInfo.viewer;
msiData: MsiData ~ NARROW[msInfo.data];
altFileData: BCFileData;
logName ¬ UserProfile.Token[key: "BlackCherry.altMailLog", default: NIL];
IF logName = NIL THEN logName ¬ PathInHomeDirectory["BlackCherryAlt.mailLog"];
Report["\n\t using %g as temp file\n", [rope[logName]] ];
[newList, newLast] ¬ DoCopyOrExpunge[msInfo, logName, altFileData ¬ fileProcs.openOrCreate[logName, $create], sortem ];
};
CloseAllProc:
ENTRY
PROC[msInfo: MsgSetInfo] = {
v: Viewer ¬ msInfo.msgDisplayer;
tsv: Viewer ¬ ViewerIO.GetViewerFromStream[reportStrm];
IF v # NIL AND NOT v.destroyed AND NOT (ViewerOps.FetchProp[v, $Frozen] # NIL) THEN ViewerOps.DestroyViewer[v];
IF NOT tsv.iconic THEN ViewerOps.CloseViewer[tsv];
ViewerOps.CloseViewer[msInfo.viewer];
};
AppendMsgProc:
INTERNAL
PROC[msInfo: MsgSetInfo] = {
curSel: ROPE = ViewerTools.GetSelectionContents[];
curV: Viewer = ViewerTools.GetSelectedViewer[];
msgID, plainText, formatting: ROPE;
IF curSel.Length[] < 2
THEN {
tc: ViewerTools.TiogaContents;
IF curV =
NIL
THEN {
Report["No selection or selected viewer to append\n"];
RETURN
};
msgID ¬ NARROW[ViewerOps.FetchProp[curV, $CherryMsgName]];
tc ¬ SendMailOps.GetCRTiogaContents[curV];
plainText ¬ tc.contents;
formatting ¬ tc.formatting;
}
ELSE plainText ¬ curSel;
IF msgID = NIL THEN msgID ¬ GenerateMsgName[plainText];
DoAppendMsg[msInfo, msgID, plainText, formatting];
AddMsgs[msInfo, showDels];
};
GenerateMsgName:
PROC[rp:
ROPE]
RETURNS[
ROPE] ~ {
being lazy
name: ROPE ~ IF userRNameList # NIL THEN userRNameList.first.name ELSE "NoName:Parc:Xerox";
RETURN[IO.PutFR["%g $ Selected@%g", [rope[name]], [time[BasicTime.Now[]]]] ];
};
NSToTioga:
ENTRY
PROC[msInfo: MsgSetInfo] = {
input: TiogaAccess.Reader ¬ TiogaAccessViewers.FromSelection[];
output: TiogaAccess.Writer ¬ TiogaAccess.Create[];
DoNSToTiogaProc[input, output];
TiogaAccessViewers.WriteSelection[output];
};
TiogaToNS:
ENTRY
PROC[msInfo: MsgSetInfo] = {
input: TiogaAccess.Reader ¬ TiogaAccessViewers.FromSelection[];
output: TiogaAccess.Writer ¬ TiogaAccess.Create[];
DoTiogaToNSProc[input, output];
TiogaAccessViewers.WriteSelection[output];
};
Custom procedure registration
customProcs:
PUBLIC CustomProcs ¬
NIL;
These procedures are called at various times throughout the processing of a message.
RegisterCustomProcs:
PUBLIC
PROC[procs: CustomProcs] ~ {
Register a complete new set of procedures, replacing previous procedures. If procs is NIL then the default procedures are reinstated.
customProcs ¬ procs;
};
GetCustomProcs:
PUBLIC
PROC[]
RETURNS [procs: CustomProcs] ~ {
Returns the currently registered set of procedures.
procs ¬ customProcs;
};
Errlog/Viewer - MessageWindow equivilent?
reportStrm: IO.STREAM;
reportName: ROPE;
TSStream:
PROC [name:
ROPE]
RETURNS [out:
IO.STREAM] ~ {
v: ViewerClasses.Viewer ¬ ViewerOps.FindViewer[name];
logName: ROPE ¬ UserProfile.Token["BlackCherry.typescriptLogName", NIL];
out ¬ ViewerIO.CreateViewerStreams[name, v, logName, FALSE].out;
IF debugging THEN out.PutF1["\n\t* v = %g\n", [integer[LOOPHOLE[v]]] ];
IF
( v =
NIL )
THEN {
v ¬ ViewerIO.GetViewerFromStream[out];
tsViewerEventRegistration ¬ ViewerEvents.RegisterEventProc[QuitBC, destroy, v];
TRUSTED { IF debugging THEN out.PutF1["\n\t***register v = %g\n", [integer[LOOPHOLE[v]]] ] };
};
IF ( v#NIL ) THEN IF ( v.iconic ) THEN ViewerOps.OpenIcon[v];
v.inhibitDestroy ¬ TRUE;
reportName ¬ name;
};
QuitBC: ViewerEvents.EventProc = {
TRUSTED { Process.Detach[FORK QuitBCX[viewer] ] };
RETURN[TRUE]; -- we'll destroy it below
};
QuitBCX: PROC[viewer: Viewer] = {
so one can debug this code
v: Viewer ¬ ViewerIO.GetViewerFromStream[reportStrm];
IF debugging
THEN {
reportStrm.PutF["\n\t***destroy v = %g, viewer = %g\n",
[integer[LOOPHOLE[v]]] , [integer[LOOPHOLE[viewer]]] ];
reportStrm.PutF1["about to unregister reportStrm: %g\n", [integer[LOOPHOLE[reportStrm]]] ];
};
IF v # viewer THEN RETURN;
SendMailOps.UnregisterReporter[reportStrm];
reportStrm.Flush[];
ViewerEvents.UnRegisterEventProc[tsViewerEventRegistration, destroy];
tsViewerEventRegistration ¬ NIL;
v.inhibitDestroy ¬ FALSE;
ViewerOps.DestroyViewer[v];
};
Report:
PUBLIC
PROC [format:
ROPE, v1, v2, v3:
IO.Value ¬ [null[]] ] ~ {
ENABLE IO.Error => IF ( ec = StreamClosed ) THEN GOTO reOpen ELSE REJECT;
reportStrm.PutF[format, v1, v2, v3];
EXITS
reOpen => {
v: Viewer;
reportStrm ¬ TSStream[reportName];
reportStrm.PutF[format, v1, v2, v3];
v ¬ ViewerIO.GetViewerFromStream[reportStrm];
};
};
TiogaButtons/Viewer
GetMsgID:
PUBLIC
PROC [msInfo: MsgSetInfo, msgH: MsgHandle]
RETURNS [id:
ROPE]~ {
read: IO.STREAM ~ msInfo.fileData.readStream;
pos: INT ¬ msgH.entryStart;
read.SetIndex[pos];
FOR n:
CARD16
IN [0..2)
DO
WHILE
TRUE
DO
ch: CHAR ~ read.GetChar[];
IF (ch = '\n) OR (ch = '\r) THEN EXIT;
pos ¬ pos.SUCC;
ENDLOOP;
ENDLOOP;
id ¬ read.GetLineRope[];
};
ClearDisplayer:
PROC [msInfo: MsgSetInfo] ~ {
FOR msgH: MsgHandle ¬ msInfo.first, msgH.next
WHILE ( msgH #
NIL )
DO
IF ( msgH.tocButton = NIL ) THEN LOOP;
TiogaButtons.DeleteButton[msgH.tocButton];
msgH.tocButton ¬ NIL;
ENDLOOP;
};
AddMsgs:
PROC [msInfo: MsgSetInfo, doShowDels:
BOOL] ~ {
v: Viewer = msInfo.viewer;
v.inhibitDestroy ¬ TRUE;
FOR each: MsgHandle ¬ msInfo.first, each.next
UNTIL each =
NIL
DO
IF ( each.tocButton # NIL ) THEN LOOP;
IF
( (
NOT each.deleted )
OR ( doShowDels )
)
THEN {
each.tocButton ¬ TiogaButtons.CreateButton[
viewer: msInfo.tiogaViewer,
rope: IF customProcs#NIL AND customProcs.msgButtonText#NIL THEN customProcs.msgButtonText[msInfo, each] ELSE each.toc,
format: "header",
looks:
SELECT
TRUE
FROM
each.deleted => IF ( each.unRead )
THEN tocDelAndUnreadLooks ELSE deletedLooks,
each.unRead => tocUnreadLooks,
ENDCASE => tocDefaultLooks,
proc: MsgSetSelectionProc,
clientData: each];
each.msInfo ¬ msInfo;
};
ENDLOOP;
v.inhibitDestroy ¬ FALSE;
};
MsgSetSelectionProc:
ENTRY TiogaButtons.TiogaButtonProc ~ {
ENABLE UNWIND => NULL;
msgH: MsgHandle ~ NARROW[clientData];
ok: BOOL ~ SelectMsgInMsgSet[msgH];
IF NOT ok THEN RETURN;
SELECT
TRUE
FROM
( control
AND shift ) => {
stream: IO.STREAM ~ msgH.msInfo.fileData.writeStream;
IF stream = NIL THEN RETURN;
msgH.deleted ¬ FALSE;
stream.SetIndex[msgH.charPos];
stream.PutChar[' ];
CheckForFlush[msgH.msInfo];
TiogaButtons.ChangeButtonLooks[button: msgH.tocButton, removeLooks: deletedLooks];
};
( control
AND
NOT shift ) => {
IF msgH.msInfo.fileData.writeStream = NIL THEN RETURN;
ShowAsDeleted[msgH];
};
( mouseButton # red ) => {
DisplayOneMsg[msgH, shift];
};
ENDCASE => { NULL };
};
DisplayOneMsg:
PUBLIC
PROC [msgH: MsgHandle, grow:
BOOL] ~ {
LockedSetMenu: PROC ~ { ViewerOps.SetMenu[v, msgMenu] };
read: IO.STREAM ~ msgH.msInfo.fileData.readStream;
msInfo: MsgSetInfo ~ msgH.msInfo;
v: Viewer ¬ msInfo.msgDisplayer;
tc: TiogaContents ~ NEW[TiogaContentsRec];
cherryMsgName: ROPE;
painted: BOOL ¬ FALSE;
herald: ROPE ~ msgH.toc.Substr[13]; -- after date
IF ( msgH.gvID = NIL ) THEN msgH.gvID ¬ GetMsgID[msInfo, msgH];
cherryMsgName ¬ msgH.gvID;
[tc.contents, tc.formatting] ¬ GetMsgContents[msInfo, msgH];
IF ( ( v =
NIL )
OR ( v.destroyed )
OR ( ViewerOps.FetchProp[v, $Frozen] #
NIL ) )
THEN {
v ¬ ViewerOps.CreateViewer[flavor: $Text, paint: NOT grow,
info: [name: herald, icon: msgIcon, scrollable: TRUE, iconic: FALSE] ];
ViewerLocks.CallUnderWriteLock[LockedSetMenu, v];
msInfo.msgDisplayer ¬ v;
ViewerOps.AddProp[v, $BlackCherry, msInfo];
}
ELSE {
who: Viewer ¬ TiogaOps.GetSelection[feedback].viewer;
IF ( who = v ) THEN TiogaOps.CancelSelection[feedback];
v.name ¬ herald;
ViewerOps.PaintViewer[v, caption];
check to see whether AllLevels will cause a paint
{
WITH v.data
SELECT
FROM
tdd: TEditDocument.TEditDocumentData => {
IF ( tdd.clipLevel # TEditDocument.maxClip ) THEN painted ¬ TRUE;
};
ENDCASE => { NULL };
};
};
IF ( (
NOT tc.formatting.IsEmpty[] )
OR ( plainTextStyle.Equal["cedar",
FALSE] ) )
THEN {
-- Tioga formatted; needn't reset the style
ViewerTools.SetTiogaContents[v, tc, NOT painted];
TiogaMenuOps.AllLevels[v];
}
ELSE {
-- Plain Text
ViewerTools.SetTiogaContents[v, tc, FALSE];
TiogaOps.SaveSelB[];
TiogaOps.SelectDocument[viewer: v, level: point];
TiogaOps.SetStyle[plainTextStyle, root];
v.newVersion ¬ FALSE; -- Is there a ``better'' way to do this?
ViewerOps.PaintViewer[v, all];
TiogaOps.RestoreSelB[];
};
ViewerTools.InhibitUserEdits[v];
ViewerOps.AddProp[v, $CherryMsgName, cherryMsgName ];
SELECT
TRUE
FROM
( v.iconic ) => { ViewerOps.OpenIcon[v, grow] };
( grow ) => { ViewerOps.GrowViewer[v] };
ENDCASE => { NULL };
v.label ¬ herald;
ShowAsRead[msgH];
};
ShowAsRead:
PROC [msgH: MsgHandle] ~ {
IF ( msgH.unRead )
THEN {
stream: IO.STREAM ~ msgH.msInfo.fileData.writeStream;
IF stream = NIL THEN RETURN;
msgH.unRead ¬ FALSE;
stream.SetIndex[msgH.charPos.SUCC];
stream.PutChar[' ];
CheckForFlush[msgH.msInfo];
};
TiogaButtons.ChangeButtonLooks[button: msgH.tocButton, removeLooks: tocUnreadLooks];
};
ShowAsDeleted:
PROC [msgH: MsgHandle] ~ {
IF (
NOT msgH.deleted )
THEN {
stream: IO.STREAM ~ msgH.msInfo.fileData.writeStream;
IF stream = NIL THEN RETURN;
msgH.deleted ¬ TRUE;
stream.SetIndex[msgH.charPos];
stream.PutChar['*];
CheckForFlush[msgH.msInfo];
};
TiogaButtons.ChangeButtonLooks[button: msgH.tocButton, addLooks: deletedLooks];
};
SelectMsgInMsgSet:
PROC [msgH: MsgHandle]
RETURNS[ok:
BOOL ¬
TRUE] ~ {
msInfo: MsgSetInfo ~ msgH.msInfo;
prevSelected: MsgHandle;
IF msInfo =
NIL
THEN {
Report["\n*** trying to select msg that is no longer in a displayer\n"];
RETURN[FALSE];
};
IF ( ( prevSelected¬ msInfo.selected ) = msgH ) THEN RETURN;
turn off previous selection
IF ( prevSelected # NIL ) THEN TiogaButtons.ChangeButtonLooks[
button: prevSelected.tocButton,
addLooks: tocDefaultLooks,
removeLooks: tocSelectedLooks];
TiogaButtons.ChangeButtonLooks[button: msgH.tocButton, addLooks: tocSelectedLooks];
msInfo.selected ¬ msgH;
};
AdvanceSelection:
PROC [msgH: MsgHandle, skipDeleted:
BOOL ¬
TRUE]
RETURNS [next: MsgHandle] ~ {
next ¬ msgH.next;
DO
SELECT
TRUE
FROM
( next = NIL ) => { RETURN };
( next.tocButton = NIL ) => { NULL };
( next.deleted AND skipDeleted ) => { NULL };
ENDCASE => { [] ¬ SelectMsgInMsgSet[next]; RETURN };
next ¬ next.next;
ENDLOOP;
};
DestroyMSViewer: ViewerEvents.EventProc ~ {
msInfo: MsgSetInfo ~ NARROW[ViewerOps.FetchProp[viewer, $BlackCherry]];
Shutdown[msInfo];
};
xxx
Shutdown:
PROC [msInfo: MsgSetInfo] ~ {
msgV: Viewer ¬ msInfo.msgDisplayer;
v: Viewer ¬ ViewerIO.GetViewerFromStream[reportStrm];
msiData: MsiData ~ NARROW[msInfo.data];
IF ( msInfo.fileData.writeStream # NIL ) THEN msInfo.fileData.writeStream.Close[];
IF ( msInfo.fileData.readStream # NIL ) AND ( msInfo.fileData.readStream # msInfo.fileData.writeStream ) THEN msInfo.fileData.readStream.Close[];
msInfo.fileData.readStream ¬ msInfo.fileData.writeStream ¬ NIL;
IF ( ( msgV # NIL ) AND ( NOT msgV.destroyed ) )
THEN ViewerOps.DestroyViewer[msgV];
ViewerEvents.UnRegisterEventProc[msInfo.destroyER, destroy];
v.inhibitDestroy ¬ FALSE;
IF msiData.allowNewMail THEN [] ¬ NewP[]; -- Flushes current new mail alert processes
Report["\n~~~~~~~~~~ Exiting BlackCherry for log %g\n", [rope[msInfo.fileName]] ];
RemoveFromMsInfoList[msInfo];
};
locked access to currentP
currentP: NAT ¬ 0;
CurrentP: ENTRY PROC RETURNS [NAT] ~ { RETURN [currentP] };
NewP: ENTRY PROC RETURNS [NAT] ~ { RETURN [currentP ¬ currentP.SUCC] };
Mail polling & new mail Alert Button
newMailAlertButton: Buttons.Button;
curRH: RetrieveHandle; -- global data
ReportChangesProc: TYPE ~ PROC [rh: MailRetrieve.Handle, newState: MailRetrieve.MBXState];
CheckStateClick: Buttons.ButtonProc ~ TRUSTED { Process.Detach[FORK CheckState[]] };
CreateAlertButton:
PROC ~ {
alertButton: BOOL ~ UserProfile.Boolean["BlackCherry.newMailAlertButton", TRUE];
IF ( ( newMailAlertButton =
NIL )
AND ( alertButton ) )
THEN {
newMailAlertButton ¬ Buttons.Create[info: [name: "BC-Mail"], proc: CheckStateClick];
};
};
CloseRetrieveHandle:
PUBLIC
INTERNAL
PROC ~ {
this gets called via StartBlackCherryRead, which is an entry proc
IF ( curRH #
NIL )
AND ( curRH.credentials #
NIL )
THEN MailRetrieve.Close[curRH.mHandle];
curRH ¬ NIL;
};
EntryMakeAndSetNewHandle:
ENTRY
PROC [ credentials:
LIST
OF MailUtils.Credentials, msiData: MsiData, pollingInterval:
INT ¬ 300 ] ~
{ MakeAndSetNewHandle[credentials, msiData, pollingInterval] };
MakeAndSetNewHandle:
PUBLIC
INTERNAL
PROC [ credentials:
LIST
OF MailUtils.Credentials, msiData: MsiData, pollingInterval:
INT ¬ 300 ] ~ {
rh: RetrieveHandle ¬ NEW[RetrieveHandleRec];
rh.credentials ¬ credentials;
rh.msiData ¬ msiData;
rh.mHandle ¬ MailRetrieve.Create[pollingInterval, WatchMailBox];
FOR tail:
LIST
OF MailUtils.Credentials ¬ rh.credentials, tail.rest
WHILE ( tail #
NIL )
DO
MailRetrieve.NewUser[rh.mHandle, tail.first.rName, tail.first.password];
ENDLOOP;
curRH ¬ rh;
};
WatchMailBox: ReportChangesProc ~ {
This is called when the condition of the mailbox changes
SetMH:
ENTRY
PROC ~ {
IF curRH #
NIL
THEN {
curRH.lastStateReported ¬ newState;
IF ( curRH.msiData.checkStateReporting THEN {
newStateRope: ROPE ~ SELECT newState FROM
allDown => "allDown",
someEmpty => "someEmpty",
allEmpty => "allEmpty",
notEmpty => "notEmpty",
ENDCASE => "weird MBXState";
Report["==> WatchMailBox: newstate = %g, p = %g\n", [rope[newStateRope]],
[cardinal[currentP]] ];
};
};
status:
ROPE ~
SELECT newState
FROM
badName => "name invalid, please log in",
badPwd => "credentials invalid, please log in",
cantAuth => "cannot authenticate credentials at this time",
userOK => "credentials authenticated",
allDown => NIL,
someEmpty => NIL,
allEmpty => NIL,
notEmpty => NIL,
unknown => NIL,
ENDCASE => "Bad MBXState!";
IF ( newState = unknown ) THEN RETURN;
IF ( status # NIL ) THEN Report["\nmailbox status: %g", [rope[status]]];
SetMH[];
};
Generic Rope ops
GetMsgContents:
PUBLIC
PROC [msInfo: MsgSetInfo, msgH: MsgHandle]
RETURNS [contents, formatting:
ROPE] ~ {
headerPos, textLen: INT;
IF ( msgH.formatLen # 0 )
THEN {
headerPos ¬ msgH.headersPos-1;
textLen ¬ msgH.textLen+1;
}
ELSE {
headerPos ¬ msgH.headersPos;
textLen ¬ msgH.textLen
};
contents ¬ ReadRope[msInfo.fileData.readStream, headerPos, textLen];
IF ( msgH.formatLen # 0 )
THEN
formatting ¬ ReadRope[msInfo.fileData.readStream, msgH.formatPos, msgH.formatLen];
};
ReadRope:
PROC [stream:
IO.STREAM, start, len:
INT]
RETURNS [r:
ROPE] ~ {
rem: INT ¬ IO.GetLength[stream] - start;
IF ( rem < len ) THEN len ¬ rem;
IF ( len < 2048 )
THEN
TRUSTED {
Short enough to make in one piece
nat: NAT ¬ len;
text: Rope.Text ¬ Rope.NewText[nat];
stream.SetIndex[start];
[] ¬ IO.GetBlock[stream, LOOPHOLE[text], 0, nat];
RETURN [text];
};
The rope is too large to make in one piece, so we divide the length in two and recursviely call ourselves. This gets at least 1024 characters in each piece in a balanced binary tree, so the recursion is quite acceptable even for large messages.
rem ¬ len / 2;
len ¬ len - rem;
r ¬ ReadRope[stream, start, len];
Do this first to ensure that the evaluation order is OK.
r ¬ Rope.Concat[r, ReadRope[stream, start+len, rem] ];
};
BlackCherryFlushMsgs:
ENTRY Commander.CommandProc ~ {
msInfo: MsgSetInfo ~ GetInforForMail[];
msiData: MsiData;
IF msInfo = NIL THEN RETURN;
msiData ¬ NARROW[msInfo.data];
msiData.okToFlushMail ¬ TRUE;
};
BlackCherryDontFlushMsgs:
ENTRY Commander.CommandProc ~ {
msInfo: MsgSetInfo ~ GetInforForMail[];
msiData: MsiData;
IF msInfo = NIL THEN { nextInfoForMailDontFlush ¬ TRUE; RETURN };
msiData ¬ NARROW[msInfo.data];
msiData.okToFlushMail ¬ FALSE;
};
msInfoList: LIST OF MsgSetInfo;
nextInfoForMailDontFlush:
BOOL ¬
FALSE;
CheckForNewMailAllowed:
ENTRY
PROC
RETURNS[newMailAllowed:
BOOL] ~
{ RETURN[GetInforForMail[] = NIL] };
CheckForFlushMsgs:
ENTRY
PROC[msiData: MsiData] ~ {
IF NOT msiData.allowNewMail THEN RETURN;
IF NOT nextInfoForMailDontFlush THEN RETURN;
msiData.okToFlushMail ¬ FALSE;
nextInfoForMailDontFlush ¬ FALSE;
};
GetInforForMail:
INTERNAL
PROC
RETURNS[MsgSetInfo] ~ {
FOR mL:
LIST
OF MsgSetInfo ¬ msInfoList, mL.rest
UNTIL mL =
NIL
DO
msiData: MsiData ¬ NARROW[mL.first.data];
IF msiData.allowNewMail THEN RETURN[mL.first];
ENDLOOP;
RETURN[NIL];
};
AddToMsInfoList:
ENTRY
PROC[msInfo: MsgSetInfo] =
{ msInfoList ¬ CONS[msInfo, msInfoList]; };
RemoveFromMsInfoList:
ENTRY
PROC[msInfo: MsgSetInfo] = {
prev: LIST OF MsgSetInfo;
IF msInfoList = NIL THEN RETURN; -- error maybe?
FOR mL:
LIST
OF MsgSetInfo ¬ msInfoList, mL.rest
UNTIL mL =
NIL
DO
IF mL.first # msInfo THEN { prev ¬ mL; LOOP };
IF prev =
NIL
THEN msInfoList ¬ msInfoList.rest
ELSE prev.rest ¬ mL.rest;
RETURN;
ENDLOOP;
};
Init:
PROC ~ {
CreateMenus[];
Commander.Register["BlackCherry", Blackie, "Reading mail for later Cherry consumption"];
Commander.Register["BlackCherryFlushMsgs", BlackCherryFlushMsgs, "Tells BlackCherry to flush messages from the servers"];
Commander.Register["BlackCherryDontFlushMsgs", BlackCherryDontFlushMsgs, "Tells BlackCherry not to flush messages from the servers"];
EntryMakeAndSetNewHandle[credentials, NIL];
};
Init[];
END.