MailUtilsImpl.mesa
Copyright Ó 1988, 1898, 1990, 1991, 1993 by Xerox Corporation. All rights reserved.
Doug Terry, December 12, 1988 6:21:50 pm PST
Wes Irish, December 21, 1988 9:49:34 pm PST
Willie-sue, February 15, 1993 3:18 pm PST
Utilities for manipulating mail messages, postmarks, recipients, etc.
DIRECTORY
BasicTime USING [earliestGMT, GMT, Now, nullGMT],
Char USING [Set],
Convert USING [Error, RopeFromTimeRFC822, TimeFromRope],
IO,
MailBasics,
MailBasicsItemTypes,
NodeProps,
Process USING [PauseMsec],
Rope,
MailUtils,
MailUtilsBackdoor,
TextEdit,
TextNode,
Tioga,
TiogaIO,
ViewerTools USING [TiogaContents, TiogaContentsRec];
MailUtilsImpl:
CEDAR
MONITOR
IMPORTS BasicTime, Char, Convert, IO, Process, Rope, NodeProps, TextEdit, TextNode, TiogaIO
EXPORTS MailUtils, MailUtilsBackdoor
~ BEGIN OPEN MailUtils;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE = IO.STREAM;
CredentialsProcs:
TYPE =
RECORD [
which: ATOM,
proc: UserCredentialsProc,
loggedIn: LoggedInUserProc,
local: LocalNameProc,
who: WhoIsLoggedInProc
];
GetUserCredentials:
PUBLIC
ENTRY
PROC [which:
ATOM]
RETURNS [creds:
LIST
OF MailUtils.Credentials] ~ {
ENABLE UNWIND => NULL;
FOR ucL:
LIST
OF CredentialsProcs ¬ userCredentialsProcList, ucL.rest
UNTIL ucL=
NIL
DO
this: Credentials ¬ NIL;
IF ( which = NIL ) OR ( which = ucL.first.which ) THEN this ¬ ucL.first.proc[];
IF this # NIL THEN creds ¬ CONS[this, creds];
ENDLOOP;
};
userCredentialsProcList:
LIST
OF CredentialsProcs ¬
NIL;
RegisterUserCredentialsProc:
PUBLIC
ENTRY
PROC [which:
ATOM,
proc: UserCredentialsProc, loggedIn: LoggedInUserProc, local: LocalNameProc,
who: WhoIsLoggedInProc] = {
ENABLE UNWIND => NULL;
userCredentialsProcList ¬ CONS[[which, proc, loggedIn, local, who], userCredentialsProcList];
};
IsThisTheLoggedInUser:
PUBLIC
ENTRY
PROC [cdL:
LIST
OF Credentials]
RETURNS [yes:
BOOL] = {
ENABLE UNWIND => NULL;
atLeastOne: BOOL ¬ FALSE;
IF userCredentialsProcList = NIL THEN RETURN[FALSE];
yes ¬ TRUE;
FOR cL:
LIST
OF Credentials ¬ cdL, cL.rest
UNTIL cL=
NIL
DO
FOR ucL:
LIST
OF CredentialsProcs ¬ userCredentialsProcList, ucL.rest
UNTIL ucL=
NIL
DO
this: BOOL;
IF ( cL.first.rName.ns # ucL.first.which ) THEN LOOP;
this ¬ ucL.first.loggedIn[cL.first];
yes ¬ yes AND this;
atLeastOne ¬ TRUE;
ENDLOOP;
ENDLOOP;
RETURN[atLeastOne AND yes];
};
LocalNameFromRName:
PUBLIC
ENTRY LocalNameProc = {
ENABLE UNWIND => NULL;
FOR ucL:
LIST
OF CredentialsProcs ¬ userCredentialsProcList, ucL.rest
UNTIL ucL =
NIL
DO
IF ( rName.ns # ucL.first.which ) THEN LOOP;
IF ( local ¬ ucL.first.local[rName] ) # NIL THEN RETURN;
ENDLOOP;
};
GetLoggedInUser:
PUBLIC
ENTRY
PROC[which:
ATOM]
RETURNS[who:
ROPE]= {
ENABLE UNWIND => NULL;
FOR ucL:
LIST
OF CredentialsProcs ¬ userCredentialsProcList, ucL.rest
UNTIL ucL =
NIL
DO
IF ( which # ucL.first.which ) THEN LOOP;
IF ( who ¬ ucL.first.who[] ) # NIL THEN RETURN;
ENDLOOP;
};
GeneratePostmark:
PUBLIC
PROC [gmt: BasicTime.
GMT ¬ BasicTime.nullGMT, machine:
ROPE]
RETURNS [ts: MailBasics.Postmark] ~ {
Generate a postmark from a message's time (when sent), machine (where posted or originated), and sender (who sent); if gmt is BasicTime.nullGMT then BasicTime.Now[] is used.
tr: ROPE;
msgNameFormat: ROPE = "$ %g@%g";
IF gmt=BasicTime.nullGMT THEN gmt ¬ BasicTime.Now[];
tr ¬ Convert.RopeFromTimeRFC822[gmt]; -- will cause problems soon
check for Bogus (in 1993) dates in 2xxx
[] ¬ Convert.TimeFromRope[tr ! Convert.Error => {
tr ¬ Convert.RopeFromTimeRFC822[BasicTime.Now[]]; CONTINUE} ];
ts ¬ IO.PutFR[msgNameFormat, [rope[machine]], [rope[tr]]];
};
GetTimeFromPostmark:
PUBLIC
PROC [postmark: MailBasics.Postmark]
RETURNS [time: BasicTime.
GMT ¬ BasicTime.earliestGMT] ~ {
Gets the time out of the message postmark.
tr: ROPE = Rope.Substr[base: postmark, start: Rope.Find[s1: postmark, s2: "@"]+1];
time ¬ Convert.TimeFromRope[tr ! Convert.Error => CONTINUE];
};
IsThisAPostmark:
PUBLIC
PROC[r:
ROPE]
RETURNS [yes:
BOOLEAN] ~ {
Returns TRUE if r has the form of a known MailBasics.Postmark.
tr: ROPE;
yes ¬ TRUE;
IF Rope.Find[r, "$"] = -1 THEN RETURN [FALSE];
IF Rope.Find[r, "@"] = -1 THEN RETURN [FALSE];
tr ¬ Rope.Substr[base: r, start: Rope.Find[s1: r, s2: "@"]+1];
[] ¬ Convert.TimeFromRope[tr ! Convert.Error => {yes ¬ FALSE; CONTINUE}];
RETURN [yes];
};
RopeFromItemType:
PUBLIC PROC [itemType: MailBasics.ItemType]
RETURNS [rope:
ROPE] ~ {
OPEN MailBasicsItemTypes;
rope ¬
SELECT itemType
FROM
envelope => "envelope",
header => "header",
vpFolder => "vpFolder",
nsTextFile => "nsTextFile",
vpDocument => "vpDocument",
otherNSFile => "otherNSFile",
multinationalNote => "multinationalNote",
ia5Note => "ia5Note",
pilotFile => "pilotFile",
g3Fax => "g3Fax",
teletex => "teletex",
telex => "telex",
iso6937Note => "iso6937Note",
interpress => "interpress",
plainTextForFormatting => "plainTextForFormatting",
fullTextWithFormatting => "fullTextWithFormatting",
vpFolderSerializedFile => "vpFolderSerializedFile",
vpDocumentSerializedFile => "vpDocumentSerializedFile",
nsTextFileSerializedFile => "nsTextFileSerializedFile",
otherNSFileSerializedFile => "otherNSFileSerializedFile",
interpressSerializedFile => "interpressSerializedFile",
postscriptSerializedFile => "postscriptSerializedFile",
postscript => "postscript",
text => "text",
tioga1 => "tioga1",
tioga2 => "tioga2",
walnutLog => "walnutLog",
capability => "capability",
audio => "audio",
interscript => "interscript",
messageComposer => "messageComposer",
lastItem => "lastItem",
ENDCASE =>
SELECT
TRUE
FROM
itemType >= smalltalk AND itemType <= lastSmallTalk => IO.PutFR1["smalltalk(%g)", [cardinal[itemType]]],
itemType >= interlisp AND itemType <= lastInterlisp => IO.PutFR1["interlisp(%g)", [cardinal[itemType]]],
itemType >= gGW AND itemType <= lastGGW => IO.PutFR1["gGW(%g)", [cardinal[itemType]]],
itemType >= cedar AND itemType <= lastCedar => IO.PutFR1["cedar(%g)", [cardinal[itemType]]],
itemType >= voice AND itemType <= lastVoice => IO.PutFR1["voice(%g)", [cardinal[itemType]]],
ENDCASE => IO.PutFR1["unknown(%g)", [cardinal[itemType]]];
};
RopeFromStream:
PUBLIC
PROC [s:
STREAM, maxTextRun:
INT ¬ 2048]
RETURNS [contents:
ROPE] ~ {
text: Rope.Text ¬ Rope.NewText[maxTextRun];
pos: NAT ¬ 0;
bytesRead: NAT ¬ 0;
WHILE
NOT
IO.EndOf[s]
DO
TRUSTED {bytesRead ¬ IO.GetBlock[s, LOOPHOLE[text], pos, text.max]};
pos ¬ pos + bytesRead;
IF pos >= text.max
THEN {
contents ¬ Rope.Concat[contents, text];
text ¬ Rope.NewText[maxTextRun];
pos ¬ 0;
};
IF bytesRead = 0 AND NOT IO.EndOf[s] THEN Process.PauseMsec[200];
ENDLOOP;
IF pos > 0 THEN contents ¬ Rope.Concat[contents, Rope.Substr[text, 0, pos]];
};
GetCRTiogaContents:
PUBLIC
PROC [root: TextNode.Ref]
RETURNS [contents: ViewerTools.TiogaContents ¬
NIL] ~ {
root.comment ¬ FALSE;
NodeProps.PutProp[n: root, name: $NewlineDelimiter, value: "\r"];
FOR each: TextNode.Ref ¬ TextNode.StepForward[root], TextNode.StepForward[each]
UNTIL each =
NIL
DO
size: INT ~ Rope.Size[each.rope];
FOR index:
INT ¬ Rope.SkipTo[s: each.rope, pos: 0, skip: "\l\r"], Rope.SkipTo[s: each.rope, pos: index+1, skip: "\l\r"]
UNTIL index = size
DO
IF Char.Set[TextEdit.FetchChar[each, index]] = 0
THEN {
[] ¬ TextEdit.ReplaceByRope[root: root, dest: each, start: index, len: 1, rope: "\r", looks: ALL[FALSE], charSet: 0];
}
ELSE {
This was a XC character that contained a LF or CR in the low order bits. This should never happen!
[] ¬ TextEdit.ReplaceByRope[root: root, dest: each, rope: "X", start: index, len: 1, looks: ALL[FALSE], charSet: 0];
};
ENDLOOP;
ENDLOOP;
{
pair: TiogaIO.Pair ¬ TiogaIO.ToPair[root];
contents ¬ NEW[ViewerTools.TiogaContentsRec ¬ [pair.contents, pair.formatting]];
};
};
WritePlainCR:
PUBLIC
PROC [root: TextNode.Ref]
RETURNS[text: Rope.
ROPE] = {
forPlain: IO.STREAM ¬ IO.ROS[];
node: TextNode.Ref ¬ root;
level: INTEGER ¬ 0;
levelDelta: INTEGER;
first: BOOL ¬ TRUE;
pastFirstEmptyLine: BOOL ¬ FALSE;
maxWidth: INT ¬ infiniteWidth;
spaces: ROPE ~ IF indentWidth < 4 THEN " " ELSE " ";
DO
text: Tioga.Node;
col, start, len: INT ¬ 0;
[node, levelDelta] ¬ TextNode.Forward[node];
IF node=NIL THEN EXIT;
IF ( level ¬ level+levelDelta ) = 1 THEN maxWidth ¬ infiniteWidth
ELSE maxWidth ¬ lowerLevelWidth;
text ¬ node;
IF text = NIL THEN LOOP;
IF first
THEN first ¬
FALSE
ELSE {
IF pastFirstEmptyLine
THEN
SELECT text.format
FROM
$head, $body, $block, $item, $equation, $display, $indent => forPlain.PutRope["\r"];
ENDCASE => NULL;
forPlain.PutRope["\r"];
};
len ¬ text.rope.Length[];
IF len = 0 THEN pastFirstEmptyLine ¬ TRUE;
WHILE start < len
DO
end: INT ¬ -1;
THROUGH [1..level) DO forPlain.PutRope[spaces]; ENDLOOP; -- output level-1 quads of spaces
col ¬ (level-1)*indentWidth;
IF maxWidth > col
THEN {
dlmIndex: INT ~ Rope.SkipTo[s: text.rope, pos: start, skip: "\r\l"];
lim: INT ~ IF pastFirstEmptyLine THEN MIN[dlmIndex, start+maxWidth-col] ELSE dlmIndex;
end ¬ lim;
IF (lim < dlmIndex)
THEN {
FOR end ¬ end, end-1 WHILE end > start AND NOT White[text.rope.Fetch[end]] DO NULL ENDLOOP;
IF end=start THEN { end ¬ MIN[dlmIndex, Rope.SkipTo[s: text.rope, pos: start+1, skip: "\t "]] };
};
};
forPlain.PutRope[text.rope.Substr[start, end-start]];
FOR end ¬ end, end+1 WHILE end<len AND White[text.rope.Fetch[end]] DO NULL ENDLOOP;
IF end = start THEN pastFirstEmptyLine ¬ TRUE;
start ¬ end;
IF start < len
THEN {
forPlain.PutChar['\r];
SELECT text.rope.Fetch[start]
FROM
'\l,'\r => start ¬ start + 1;
ENDCASE;
};
ENDLOOP;
ENDLOOP;
text ¬ forPlain.RopeFromROS[];
forPlain.Close[];
};
infiniteWidth: INT ¬ LAST[INT]/2; --can't make too big (start+maxWidth-col) calc
lowerLevelWidth: INT ¬ 80;
White:
PROC [c:
CHAR]
RETURNS [
BOOL] ~
INLINE {
RETURN [c='
OR c='\t]};