Types and Global Variables
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
MsgInfo: TYPE = TabPostOffice.MsgInfo;
MsgInfo: TYPE = RECORD [
msgId: MsgID,
from: ROPE,
to: ROPE,
cc: ROPE,
date: ROPE,
subject: ROPE,
priority: Priority,
filters: FilterSet,
status: Status,
bodyLength: INT32,
server: SunRPC.Server;
wH: WalnutOps.WalnutOpsHandle;
noError: TabPostOffice.ErrorInfo = [errno: 0, msg: NIL];
noFilters: TabPostOffice.FilterSet = NEW[TabPostOffice.SeqType2Object[0]];
The set of messages that can be accessed during a session are stored in a RedBlackTree sorted by the desired sort-order (e.g. priority). Each element in this tree is of type MsgEntry.
MsgEntry: TYPE = REF MsgEntryRecord;
MsgEntryRecord:
TYPE =
RECORD [
walnutID: ROPE,
info: MsgInfo,
text: ROPE ← NIL,
bodyStart: INT ← -1
];
SessionInfo:
TYPE =
RECORD [
whenStarted: BasicTime.GMT,
selectList: TabPostOffice.PropInfoArray,
orderList: TabPostOffice.PropertyArray,
msgs: RedBlackTree.Table
];
session: SessionInfo;
RPC Operations
StartSession: TabPostOffice.tpostartsessionProc ~ {
[o: Server1, numselects: INT32, plist: PropInfoArray, numorders: INT32, olist: PropertyArray] RETURNS [res: SessionResult]
The plist specifies which messages are included in the new session, and the olist specifies the order in which these messages should be presented to the user. This procedures reads the messages from the database and builds a sorted RedBlack tree to hold information about the messages.
A common case is that plist is empty. In this case, a simple priority threshold is used. The code is optimized by checking for this condition before retrieving other information about the message.
ENABLE WalnutDefs.Error => {PrintDebug["WALNUT ERROR: who=%s, code=%s, explanation=%s", IO.atom[who], IO.atom[code], IO.rope[explanation]]; CONTINUE};
pThreshold: INT ¬ -1;
PrintDebug["BEGIN StartSession: numselects=%s, plist=%s, numorders=%s, olist=%s", IO.int[numselects], IO.rope[FmtPropI[plist]], IO.int[numorders], IO.rope[FmtPropA[olist]]];
session.whenStarted ¬ BasicTime.Now[];
session.selectList ¬ plist;
session.orderList ¬ olist;
session.msgs ¬ RedBlackTree.Create[getKey: GetKey, compare: CompareProc];
res.total ¬ 0;
res.unread ¬ 0;
res.new ¬ 0;
IF plist =
NIL
OR plist.size = 0
THEN {
-- use priority threshold by default
pThreshold ¬ UserProfile.Number[key: "WalnutPostOffice.PriorityThreshold", default: 50];
};
wH ¬ WalnutOps.GetHandleForRootfile[UserProfile.Token["Walnut.WalnutRootFile"]];
FOR msgSets:
LIST
OF
ROPE ← SelectedMsgSets[plist], msgSets.rest
WHILE msgSets #
NIL
DO
enum: WalnutOps.EnumeratorForMsgs;
msg: ROPE;
PrintDebug["Enumerating msgSet=%s", IO.rope[msgSets.first]];
enum ¬ WalnutOps.EnumerateMsgsInMsgSet[wH, msgSets.first ! WalnutDefs.Error => {PrintDebug["WALNUT ERROR: who=%s, code=%s, explanation=%s", IO.atom[who], IO.atom[code], IO.rope[explanation]]; CONTINUE}];
msg ¬ WalnutOps.NextMsg[enum].msgID;
WHILE msg #
NIL
DO
IF MatchesPriority[msg, pThreshold]
THEN {
msgEntry: MsgEntry ¬ GetMsgEntry[msg];
IF MatchesSelect[msgEntry, plist]
THEN {
RedBlackTree.Insert[session.msgs, msgEntry, msgEntry!
RedBlackTree.DuplicateKey => {PrintDebug["DuplicateKey!"]; CONTINUE}];
IF msgEntry.info.status # $Read THEN res.unread ¬ res.unread + 1;
};
};
msg ¬ WalnutOps.NextMsg[enum].msgID;
ENDLOOP;
ENDLOOP;
res.total ¬ AssignMsgIds[session];
res.new ¬ res.unread; -- technically this isn't right, but it's ok for now
[res.loPri, res.hiPri] ¬ GetPriorityRange[session];
res.lastModifyTime ¬ 0;
res.lastAccessTime ¬ LAST[INT32];
res.e ¬ noError;
PrintDebug["END StartSession"];
};
GetMsgInfo: TabPostOffice.tpogetmsginfoProc ~ {
[o: Server1, beginId: MsgID, endId: MsgID] RETURNS [res: MsgInfoResult]
PrintDebug["BEGIN GetMsgInfo: beginId=%s, endId=%s", IO.int[beginId], IO.int[endId]];
res.info ¬ NEW[TabPostOffice.SeqType4Object[endId-beginId+1]];
FOR id:
INT
IN [beginId..endId]
DO
msgEntry: MsgEntry ¬ LookupById[session, id];
res.info[msgEntry.info.msgId-beginId] ¬ msgEntry.info;
ENDLOOP;
res.e ¬ noError;
PrintDebug["END GetMsgInfo"];
};
GetMsgText: TabPostOffice.tpogetmsgtextProc ~ {
[o: Server1, msgId: MsgID, beginByte: INT32, numBytes: INT32, whence: Whences] RETURNS [res: MsgTextResult]
msgEntry: MsgEntry;
PrintDebug["BEGIN GetMsgText: msgId=%s, beginByte=%s, numBytes=%s, whence=%s", IO.int[msgId], IO.int[beginByte], IO.int[numBytes], IO.rope[FmtWhence[whence]]];
msgEntry ¬ LookupById[session, msgId];
res.body ¬ msgEntry.text;
IF whence = $BOB
THEN
res.body ¬ GetBody[res.body];
res.e ¬ noError;
PrintDebug["END GetMsgText"];
};
CheckNewMail: TabPostOffice.tpochecknewmailProc ~ {
[o: Server1] RETURNS [res: NewMailResult]
PrintDebug["BEGIN CheckNewMail"];
res ¬ [newMail: FALSE, e: noError];
PrintDebug["END CheckNewMail"];
};
partialFolders: BOOLEAN ¬ TRUE;
GetFolders: TabPostOffice.tpogetfoldersProc ~ {
[o: Server1] RETURNS [res: FoldersResult]
ENABLE WalnutDefs.Error => {PrintDebug["WALNUT ERROR: who=%s, code=%s, explanation=%s", IO.atom[who], IO.atom[code], IO.rope[explanation]]; CONTINUE};
list: LIST OF ROPE;
num: CARD ¬ 0;
PrintDebug["BEGIN GetFolders"];
IF partialFolders
THEN list ¬ LIST["Active", "CACM", "Cedar10", "LoganBerry", "Modula3", "ParcPad", "Tapestry", "Wallaby"]
ELSE list ¬ WalnutOps.MsgSetNames[wH].mL;
FOR mL: LIST OF ROPE ← list, mL.rest WHILE mL#NIL DO num ¬ num+1; ENDLOOP;
res.numFolders ¬ num;
res.folders ¬ NEW[TabPostOffice.SeqType3Object[num]];
num ¬ 0;
FOR mL:
LIST
OF
ROPE ← list, mL.rest WHILE mL#NIL
DO
res.folders[num] ¬ mL.first;
num ¬ num+1;
ENDLOOP;
res.e ¬ noError;
PrintDebug["END GetFolders"];
};
MarkMsg: TabPostOffice.tpomarkmsgProc ~ {
[o: Server1, msgId: MsgID, markID: ROPE, markMsg: ROPE] RETURNS [res: ErrorInfo]
PrintDebug["BEGIN MarkMsg: msgId=%s, markID=%s, markMsg=%s", IO.int[msgId], IO.rope[markID], IO.rope[markMsg]];
res ¬ noError;
PrintDebug["END MarkMsg"];
};
EndSession: TabPostOffice.tpoendsessionProc ~ {
[o: Server1] RETURNS [res: ErrorInfo]
PrintDebug["BEGIN EndSession"];
res ¬ noError;
PrintDebug["END EndSession"];
};
Selecting and Filtering Messages
defaultMsgSet: ROPE = "Active";
SelectedMsgSets:
PROC [selectList: TabPostOffice.PropInfoArray]
RETURNS [msgsets:
LIST
OF
ROPE] ~ {
Finds all of the clauses on the selectList of the form: "folder", "equals", msgset. The list of msgsets are returned. Some folder names are ignored, e.g. "All", "AllMail", "NewMail".
msgsets ¬ NIL;
FOR i:
INT
IN [0..selectList.size)
DO
IF Rope.Equal[selectList[i].p, "Folder",
FALSE]
THEN {
msgSet: ROPE;
IF NOT Rope.Equal[selectList[i].r, "Equals", FALSE] THEN LOOP; -- not supported
SELECT
TRUE
FROM
Rope.Equal[selectList[i].v, "All", FALSE] => msgSet ¬ "ZZZAll";
Rope.Equal[selectList[i].v, "AllMail", FALSE] => msgSet ¬ "ZZZAll";
Rope.Equal[selectList[i].v, "NewMail", FALSE] => msgSet ¬ "ZZZNew";
Rope.Equal[selectList[i].v, "New", FALSE] => msgSet ¬ "ZZZNew";
ENDCASE => msgSet ¬ selectList[i].v;
msgsets ¬ CONS[msgSet, msgsets];
};
ENDLOOP;
IF msgsets =
NIL
THEN {
msgsets ¬ UserProfile.ListOfTokens[key: "WalnutPostOffice.ActiveMessageSets", default: LIST[defaultMsgSet]];
};
};
MatchesPriority:
PROC [walnutID:
ROPE, threshold:
INT]
RETURNS [matches:
BOOLEAN] ~ {
Quick check to see if the message's priority is above the threshold.
priority: INT;
IF threshold < 0 THEN RETURN[TRUE];
priority ¬ MsgInterestLevel[walnutID];
matches ¬ priority >= threshold;
RETURN[matches];
};
MatchesSelect:
PROC [msgEntry: MsgEntry, selectList: TabPostOffice.PropInfoArray]
RETURNS [matches:
BOOLEAN] ~ {
Finds all of the clauses on the selectList of the form: "priority", relation, number. Returns true if this expression holds for the given msgEntry. This should eventually support other selection criteria as well.
matches ¬ TRUE;
IF msgEntry = NIL THEN RETURN[FALSE];
FOR i:
INT
IN [0..selectList.size)
DO
IF Rope.Equal[selectList[i].p, "Priority",
FALSE]
THEN {
threshold: INT ¬ -1;
threshold ¬ Convert.IntFromRope[selectList[i].v ! Convert.Error => CONTINUE];
IF threshold = -1 THEN LOOP; -- bogus value
SELECT
TRUE
FROM
Rope.Equal[selectList[i].r, "GreaterThan", FALSE] => matches ¬ msgEntry.info.priority > threshold;
Rope.Equal[selectList[i].r, "GreaterThanEquals", FALSE] => matches ¬ msgEntry.info.priority >= threshold;
Rope.Equal[selectList[i].r, "Equals", FALSE] => matches ¬ msgEntry.info.priority = threshold;
Rope.Equal[selectList[i].r, "LessThanEquals", FALSE] => matches ¬ msgEntry.info.priority <= threshold;
Rope.Equal[selectList[i].r, "LessThan", FALSE] => matches ¬ msgEntry.info.priority < threshold;
ENDCASE => NULL;
};
IF matches = FALSE THEN EXIT;
ENDLOOP;
RETURN[matches];
};
Sorting Messages
When the RedBlackTree is being built up, it is sorted by the order specified in StartSession. After all entries have been added, session-specific IDs are assigned to the messages so that the tree is also sorted by message IDs. Thus, future lookups can simply compare message IDs.
GetKey: RedBlackTree.GetKey ~ {
-- can't be an internal procedure in Cedar10.1
[data: UserData] RETURNS [Key]
RETURN[data];
};
CompareProc: RedBlackTree.Compare ~ {
[k: Key, data: UserData] RETURNS [Basics.Comparison]
result: Basics.Comparison;
key1: MsgEntry ¬ NARROW[k];
key2: MsgEntry ¬ NARROW[data];
IF key1.info.msgId # -1
AND key2.info.msgId # -1
THEN result ¬ Basics.CompareInt[key1.info.msgId, key2.info.msgId]
ELSE result ¬ CompareList[key1, key2, session.orderList];
RETURN[result];
};
CompareList:
PROC [m1, m2: MsgEntry, orderList: TabPostOffice.PropertyArray]
RETURNS [Basics.Comparison] ~ {
The properties of the two messages are compared as specified on the orderList until a property is found for which the messages are not equal. If the messages are equal in all properties on the list then Walnut message IDs (which are known to be unique) are compared.
result: Basics.Comparison ¬ $equal;
FOR i:
INT
IN [0..orderList.size)
DO
SELECT
TRUE
FROM
Rope.Equal[orderList[i], "Priority",
FALSE] =>
result ¬ ComparePriority[m1.info.priority, m2.info.priority];
Rope.Equal[orderList[i], "Date",
FALSE] =>
result ¬ CompareDate[m1.info.date, m2.info.date];
Rope.Equal[orderList[i], "From",
FALSE] =>
result ¬ Rope.Compare[m1.info.from, m2.info.from, FALSE];
Rope.Equal[orderList[i], "Subject",
FALSE] =>
result ¬ Rope.Compare[m1.info.subject, m2.info.subject, FALSE];
Rope.Equal[orderList[i], "To",
FALSE] =>
result ¬ Rope.Compare[m1.info.to, m2.info.to, FALSE];
Rope.Equal[orderList[i], "New",
FALSE] =>
result ¬ CompareStatus[m1.info.status, m2.info.status, $New, TRUE];
Rope.Equal[orderList[i], "Old",
FALSE] =>
result ¬ CompareStatus[m1.info.status, m2.info.status, $New, FALSE];
Rope.Equal[orderList[i], "Read",
FALSE] =>
result ¬ CompareStatus[m1.info.status, m2.info.status, $Read, TRUE];
Rope.Equal[orderList[i], "Unread",
FALSE] =>
result ¬ CompareStatus[m1.info.status, m2.info.status, $Read, FALSE];
ENDCASE => result ¬ $equal;
IF result # $equal THEN EXIT;
ENDLOOP;
IF result = equal
THEN
result ¬ Rope.Compare[m1.walnutID, m2.walnutID];
RETURN [result];
};
ComparePriority:
PROC [p1, p2:
INT]
RETURNS [Basics.Comparison] ~ {
Note: high priorities come before low priorities so the priorities are reversed when passed to Basics.CompareInt.
RETURN [Basics.CompareInt[p2, p1]];
};
CompareDate:
PROC [d1, d2:
ROPE, oldestFirst:
BOOLEAN ¬
TRUE]
RETURNS [Basics.Comparison] ~ {
result: Basics.Comparison;
t1, t2: BasicTime.GMT;
t1 ¬ Convert.TimeFromRope[d1 ! Convert.Error => CONTINUE];
t2 ¬ Convert.TimeFromRope[d2 ! Convert.Error => CONTINUE];
SELECT BasicTime.Period[from: t1, to: t2]
FROM
> 0 => result ¬ IF oldestFirst THEN $less ELSE $greater;
< 0 => result ¬ IF oldestFirst THEN $greater ELSE $less;
ENDCASE => result ¬ $equal;
RETURN [result];
};
CompareStatus:
PROC [s1, s2, status: TabPostOffice.Status, statusFirst:
BOOLEAN ¬
TRUE]
RETURNS [Basics.Comparison] ~ {
result: Basics.Comparison;
SELECT
TRUE
FROM
s1 = status AND s2 # status => result ¬ IF statusFirst THEN $less ELSE $greater;
s1 # status AND s2 = status => result ¬ IF statusFirst THEN $greater ELSE $less;
ENDCASE => result ¬ $equal;
RETURN [result];
};
GetPriorityRange:
PROC [session: SessionInfo]
RETURNS [low, high:
INT] ~ {
LowHigh: RedBlackTree.EachNode ~ {
[data: UserData] RETURNS [stop: BOOL ¬ FALSE]
me: MsgEntry ¬ NARROW[data];
low ¬ MIN[low, me.info.priority];
high ¬ MAX[high, me.info.priority];
};
low ¬ LAST[INT];
high ¬ 0;
RedBlackTree.EnumerateIncreasing[session.msgs, LowHigh];
};
AssignMsgIds:
PROC [session: SessionInfo]
RETURNS [total:
INT] ~ {
id: CARD ¬ 0;
NextId: RedBlackTree.EachNode ~ {
[data: UserData] RETURNS [stop: BOOL ¬ FALSE]
mi: MsgEntry ¬ NARROW[data];
mi.info.msgId ¬ id;
id ¬ id + 1;
};
RedBlackTree.EnumerateIncreasing[session.msgs, NextId];
total ¬ id;
};
Keep around a key so that a new one does not have to be allocated on each lookup; the info.msgId field simply needs to be assigned.
lookupKey: MsgEntry ¬ NEW[MsgEntryRecord];
LookupById:
PROC [session: SessionInfo, msgId:
INT]
RETURNS [entry: MsgEntry] ~ {
data: RedBlackTree.UserData;
lookupKey.info.msgId ¬ msgId;
data ¬ RedBlackTree.Lookup[session.msgs, lookupKey];
entry ¬ NARROW[data];
};
Retrieving Information about Messages
GetMsgEntry:
PROC [walnutID:
ROPE]
RETURNS [msgEntry: MsgEntry] ~ {
Retrieve from Walnut all of the information about a given message.
WalnutOps.GetMsgText sometimes raises WalnutDefs.Error[$MsgTooLong] for messages that will not fit in a REF TEXT. We can't just catch this error, since then Walnut is left in a state where it thinks that a shutdown is necessary. So we must try to avoid this situation by first checking the length of the message.
ENABLE WalnutDefs.Error => {PrintDebug["WALNUT ERROR: who=%s, code=%s, explanation=%s", IO.atom[who], IO.atom[code], IO.rope[explanation]]; CONTINUE};
GetAndCheckMsgSize:
PROC [walnutID:
ROPE]
RETURNS [nat:
NAT] = {
Returns the size of the message or 0 if the message will not fit in a NAT
CheckForNat: PROC [len: INT] RETURNS[nat: NAT] = { nat ¬ len };
len: INT ¬ WalnutOps.GetMsgSize[wH, walnutID].textLen;
lengthThreshold: INT ¬ UserProfile.Number[key: "WalnutPostOffice.LengthThreshold", default: 5000];
IF len < lengthThreshold
THEN nat ¬ len
ELSE nat ¬ 0;
BEGIN ENABLE RuntimeError.BoundsFault => {nat ¬ 0; CONTINUE};
nat ¬ CheckForNat[len]; -- doesn't seem to work for some reason.
END;
};
size: NAT;
fields: LoganBerry.Entry;
msgEntry ¬ NEW[MsgEntryRecord];
msgEntry.walnutID ¬ walnutID;
size ¬ GetAndCheckMsgSize[walnutID];
IF size # 0
THEN {
msgEntry.text ¬ RefText.TrustTextAsRope[WalnutOps.GetMsgText[wH, walnutID, NIL]];
}
ELSE {
PrintDebug["Msg <%s> too long so only grabbing headers", IO.rope[walnutID]];
msgEntry.text ¬ RefText.TrustTextAsRope[WalnutOps.GetMsgHeaders[wH, walnutID, NIL]];
msgEntry.text ¬ Rope.Concat[msgEntry.text, "\n*** Message too long! ***\n"];
};
msgEntry.text ¬ CrsToNls[msgEntry.text];
fields ¬ TapMsgQueue.EntryFromMsg[TapFilter.ParseMsgIntoFields[msgEntry.text]];
msgEntry.info.msgId ¬ -1; -- don't know ID yet since it depends on sort order
msgEntry.info.from ¬ LoganBerryEntry.GetAttr[fields, $from];
msgEntry.info.to ¬ LoganBerryEntry.GetAttr[fields, $to];
msgEntry.info.cc ¬ LoganBerryEntry.GetAttr[fields, $cc];
msgEntry.info.subject ¬ LoganBerryEntry.GetAttr[fields, $subject];
msgEntry.info.date ¬ LoganBerryEntry.GetAttr[fields, $date];
msgEntry.info.priority ¬ MsgInterestLevel[walnutID];
msgEntry.info.filters ¬ noFilters;
msgEntry.info.status ¬ IF WalnutOps.GetHasBeenRead[wH, walnutID] THEN $Read ELSE $Unread;
msgEntry.info.bodyLength ¬ Rope.Length[msgEntry.text];
msgEntry.info.bodyLines ¬ msgEntry.info.bodyLength/30; -- a very rough estimate
};
MsgInterestLevel:
PUBLIC PROC [msg:
ROPE]
RETURNS [ilevel:
INT] ~ {
Lookup the msg's ilevel in the annotation database. The default ilevel is used if a database entry is not found for this message. If the message is annotated with several ilevels then the highest one is used.
Max:
PROC [values:
LIST
OF
ROPE]
RETURNS [max:
INT] ~ {
max ¬ -1;
FOR rL:
LIST
OF
ROPE ¬ values, rL.rest
WHILE rL #
NIL
DO
i: INT ¬ LoganBerryEntry.V2I[rL.first];
ENDLOOP;
};
annotationDBName: ROPE ¬ UserProfile.Token[key: "WallTapestry.AnnotationDB", default: NIL];
ilevel ¬ -1;
IF annotationDBName # NIL THEN BEGIN
annot: TapFilter.Annotation;
annot ¬ TapFilter.GetAnnotations[annotDB: annotationDBName, msgID: msg];
ilevel ¬ Max[LoganBerryEntry.GetAllAttrs[entry: annot, type: $Level]];
ilevel ¬ MAX[ilevel, Max[LoganBerryEntry.GetAllAttrs[entry: annot, type: $level]]];
END;
IF ilevel = -1 THEN
ilevel ¬ 50;
};
GetBody:
PROC [whole:
ROPE]
RETURNS [body:
ROPE] ~ {
Find two CRs in a row since that's where the body starts.
i, previ: INT ¬ -1;
WHILE i < Rope.Length[whole]
DO
previ ¬ i;
i ¬ Rope.SkipTo[s: whole, pos: previ+1, skip: "\l\n\r"];
IF i = previ+1 THEN EXIT;
ENDLOOP;
body ¬ Rope.Substr[whole, i+1];
RETURN[body];
};
CrsToNls:
PROC [old:
ROPE]
RETURNS [new:
ROPE] ~ {
Convert all CRs to Newlines since that's what UNIX wants.
TransCrsToNls: Rope.TranslatorType ~ {
PROC [old: CHAR] RETURNS [CHAR]
IF old = '\r THEN RETURN['\l] ELSE RETURN[old];
};
new ¬ Rope.Translate[base: old, translator: TransCrsToNls];
};