GVAnswerImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Karlton, Friday Feb. 13, 1981 6:10 pm PST
Levin, March 4, 1983 2:08 PM
Brotz, March 4, 1983 12:02 PM
Willie-sue, March 19, 1985 7:35:53 pm PST
Doug Wyatt, March 7, 1985 11:12:37 am PST
Russ Atkinson (RRA) March 21, 1985 1:35:15 am PST
DIRECTORY
Ascii USING [Lower],
GVAnswer,
GVMailParse USING [endOfInput, FinalizeParse, GetFieldBody, GetFieldName, InitializeParse, ParseError, ParseHandle, ParseNameList],
IO,
Rope;
GVAnswerImpl: CEDAR PROGRAM
IMPORTS Ascii, GVMailParse, IO, Rope
EXPORTS GVAnswer
= BEGIN OPEN IO;
Local Data Structures and Types
ROPE: TYPE = Rope.ROPE;
CharIndex: TYPE = INT;
nullIndex: CharIndex = LAST[CharIndex];
Qualification: TYPE = {unqualified, dotQualified};
DuplicateNameRecord: TYPE = RECORD [name: ROPE, seenOnSecondPass: BOOL];
DuplicateName: TYPE = REF DuplicateNameRecord;
Exported Procedure
MakeHeader: PUBLIC PROC[getChar: PROC [INT] RETURNS [CHAR], getLength: INT, userName, userRegistry: ROPE, cForCopies: BOOL ← FALSE] RETURNS [answerError: BOOL, answer: ROPE, errorIndex: INT] = {
outBuffer: IO.STREAM;
getCharIndex: CharIndex;
pH: GVMailParse.ParseHandle;
havePH: BOOL ← FALSE;
idIndex: CharIndex ← nullIndex;
dateIndex: CharIndex ← nullIndex;
subjectIndex: CharIndex ← nullIndex;
fromFieldErrorIndex: CharIndex ← nullIndex;
startOfHeaderLine: CharIndex ← nullIndex;
StuffChar: PROC[char: CHAR] = {IF char # '\n THEN outBuffer.PutChar[char]};
FieldIndex: TYPE =
{id, reply, sender, from, to, cc, c, bcc, date, subject}; -- order is significant!
knownField: ARRAY FieldIndex OF ROPE =
["Message-ID", "Reply-to", "Sender", "From", "To", "cc", "c", "bcc",
"Date", "Subject"]; -- order corresponds to FieldIndex
answerTarget: FieldIndex ← SUCC[from];
originName, originRegistry: ROPE;
originQual: Qualification;
originIndex: FieldIndex ← reply; -- anything except sender or from
answerTargetBodyCharIndex: CharIndex ← nullIndex;
targetEqualsOrigin: BOOL ← TRUE;
namesOutput: BOOL ← FALSE;
replyerCCed: BOOL ← FALSE;
ccCount: CARDINAL ← 0;
DuplicateHead: LIST OF DuplicateName;
GetNextChar: PROC RETURNS [char: CHAR] = {
IF getCharIndex >= getLength THEN RETURN [GVMailParse.endOfInput];
char ← getChar[getCharIndex];
getCharIndex ← getCharIndex + 1;
};
InitParse: PROC = {pH ← GVMailParse.InitializeParse[]; havePH ← TRUE};
FinParse: PROC = {GVMailParse.FinalizeParse[pH]; havePH ← FALSE};
ProcessFields: PROC [Inner: PROC [index: FieldIndex]] = { OPEN GVMailParse;
fieldName: ROPE;
found: BOOL;
getCharIndex ← 0;
InitParse[];
DO
{
startOfHeaderLine← getCharIndex;
[fieldName, found]←
GetFieldName[pH, GetNextChar ! GVMailParse.ParseError => GOTO badIndex];
IF ~found THEN EXIT;
FOR i: FieldIndex IN FieldIndex DO
IF fieldName.Equal[knownField[i], FALSE] THEN {Inner[i]; EXIT};
REPEAT FINISHED => []← GetFieldBody[pH, GetNextChar, TRUE];
ENDLOOP;
EXITS
badIndex =>
DO
SELECT GetNextChar[] FROM
'\n, GVMailParse.endOfInput => EXIT;
ENDCASE;
ENDLOOP;
};
ENDLOOP;
FinParse[];
}; -- of ProcessFields --
AnalyzeOrigin: PROC [index: FieldIndex] = {
fieldBodyStartIndex: CharIndex = getCharIndex;
ProcessName: PROC [simpleName, registry: ROPE, isFile, ignored: BOOL]
RETURNS [reg: ROPE, write: BOOL] = {
IF ~(originIndex = sender OR index = originIndex OR index = reply) THEN {
originIndex ← index;
originName← simpleName;
originRegistry← registry;
originQual← IF originRegistry.Length[] > 0 THEN dotQualified ELSE unqualified;
[originQual, originRegistry]←
AdjustToReplyerContext[originName, originRegistry, originQual, isFile];
};
IF index < answerTarget AND index # sender THEN {
answerTarget ← index;
answerTargetBodyCharIndex ← fieldBodyStartIndex;
};
RETURN[NIL, FALSE]
}; -- of ProcessName --
GVMailParse.ParseNameList[pH, GetNextChar, ProcessName
! GVMailParse.ParseError => IF index = from THEN
{ fromFieldErrorIndex← fieldBodyStartIndex; CONTINUE}];
}; -- of AnalyzeOrigin --
FirstPass: PROC [index: FieldIndex] = {
SELECT index FROM
id => {
idIndex ← getCharIndex;
[]← GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]
};
IN [reply .. from] => AnalyzeOrigin[index];
IN [to .. bcc] => FillNameField[firstPass: TRUE];
date => {
dateIndex ← getCharIndex;
[]← GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]
};
subject => {
subjectIndex ← getCharIndex;
[]← GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]
};
ENDCASE => []← GVMailParse.GetFieldBody[pH, GetNextChar, TRUE];
}; -- of FirstPass --
AdjustToSenderContext: PROC[name, registry: ROPE]
RETURNS[qual: Qualification, reg: ROPE] = {
reg← registry;
SELECT qual← IF registry.Length[] > 0 THEN dotQualified ELSE unqualified FROM
dotQualified => {
senderRegistry: ROPE;
SELECT originQual FROM
unqualified => senderRegistry ← userRegistry;
dotQualified => senderRegistry ← originRegistry;
ENDCASE;
IF registry.Equal[senderRegistry, FALSE] THEN
{reg← NIL; qual ← unqualified}
};
ENDCASE;
}; -- of AdjustToSenderContext --
AdjustToReplyerContext: PROC [name, registry: ROPE, qual: Qualification, isFile: BOOL]
RETURNS [newQual: Qualification, reg: ROPE] = {
reg← registry;
SELECT newQual← qual FROM
unqualified =>
IF originQual = dotQualified AND ~isFile THEN
{newQual← dotQualified; reg← originRegistry};
dotQualified =>
IF registry.Equal[userRegistry, FALSE] THEN
{newQual← unqualified; reg← NIL};
ENDCASE;
}; -- of AdjustToReplyerContext --
FillField: PROC = {
field: ROPE← GVMailParse.GetFieldBody[pH, GetNextChar];
IF field.Length[] > 120 THEN -- magic number to correspond to AnswerImpl
{ outBuffer.PutRope[field.Substr[0, 120]]; outBuffer.PutRope[" ..."]}
ELSE outBuffer.PutRope[field];
}; -- of FillField --
AddedToDuplicateList: PROC [simpleName, registry: ROPE, firstPass: BOOL]
RETURNS [added: BOOL] = {
s: ROPE← simpleName;
IF registry.Length[] # 0 THEN s← s.Cat[".", registry];
FOR itemL: LIST OF DuplicateName← DuplicateHead, itemL.rest UNTIL itemL = NIL DO
IF Rope.Equal[itemL.first.name, s, FALSE] THEN {
IF firstPass THEN RETURN[FALSE];
added ← ~itemL.first.seenOnSecondPass;
itemL.first.seenOnSecondPass ← TRUE;
RETURN
};
ENDLOOP;
DuplicateHead←
CONS[NEW[DuplicateNameRecord← [name: s, seenOnSecondPass: FALSE]], DuplicateHead];
RETURN[TRUE]
}; -- of AddedToDuplicateList --
ProcessAnswerTarget: PROC = {
ProcessName: PROC [simpleName, registry: ROPE, isFile, ignored: BOOL]
RETURNS [reg: ROPE, write: BOOL] = {
qual: Qualification;
[qual, reg]← AdjustToSenderContext[simpleName, registry];
[]← AddedToDuplicateList[simpleName, reg, FALSE];
[ , reg]← AdjustToReplyerContext[simpleName, reg, qual, isFile];
RETURN[reg, TRUE];
}; -- of ProcessName --
getCharIndex ← answerTargetBodyCharIndex;
InitParse[];
GVMailParse.ParseNameList[pH, GetNextChar, ProcessName, StuffChar];
FinParse[];
}; -- of ProcessAnswerTarget --
AnalyzeAnswerTarget: PROC = {
ProcessName: PROC [simpleName, registry: ROPE, ignored1, ignored2: BOOL]
RETURNS [reg: ROPE, write: BOOL] = {
[ , reg] ← AdjustToSenderContext[simpleName, registry];
targetEqualsOrigin← targetEqualsOrigin
AND simpleName.Equal[originName, FALSE]
AND (reg.Length[] = 0 OR reg.Equal[originRegistry, FALSE]);
IF ~AddedToDuplicateList[simpleName, reg, TRUE] THEN ccCount ← ccCount - 1;
RETURN[NIL, FALSE];
}; -- of ProcessName --
IF answerTargetBodyCharIndex = 0 THEN ERROR GVMailParse.ParseError[badFieldName];
getCharIndex ← answerTargetBodyCharIndex;
InitParse[];
GVMailParse.ParseNameList
[pH, GetNextChar, ProcessName, ! GVMailParse.ParseError => answerError ← TRUE];
FinParse[];
}; -- of AnalyzeAnswerTarget --
FillNameField: PROC [firstPass: BOOL] = {
firstOutput: BOOL← TRUE;
ProcessName: PROC [simpleName, registry: ROPE, isFile, nested: BOOL]
RETURNS [reg: ROPE, write: BOOL] = {
qual: Qualification;
new: BOOL;
[qual, reg]← AdjustToSenderContext[simpleName, registry];
new← AddedToDuplicateList[simpleName, reg, firstPass];
IF ~nested AND ~new THEN RETURN[NIL, FALSE];
[ , reg]← AdjustToReplyerContext[simpleName, reg, qual, isFile];
IF firstPass THEN
{
ccCount ← ccCount + 1;
IF ~replyerCCed AND simpleName.Equal[userName, FALSE]
AND reg.Length[] = 0 THEN replyerCCed ← TRUE;
RETURN[NIL, FALSE]
};
IF firstOutput THEN
{
firstOutput ← FALSE;
IF namesOutput THEN outBuffer.PutRope[", "];
};
RETURN[reg, namesOutput← TRUE];
}; -- of ProcessName --
GVMailParse.ParseNameList[pH, GetNextChar, ProcessName, StuffChar];
}; -- of FillNameField --
SecondPass: PROC [index: FieldIndex] =
{
SELECT index FROM
IN [to .. bcc] => FillNameField[firstPass: FALSE];
ENDCASE => []← GVMailParse.GetFieldBody[pH, GetNextChar, TRUE];
}; -- of SecondPass --
main body of AnswerImpl
answerError ← FALSE;
errorIndex← nullIndex;
outBuffer← ROS[];
{
find out who it's from and where the interesting indices are
ProcessFields[FirstPass ! GVMailParse.ParseError => GO TO BadMessage];
IF answerTargetBodyCharIndex = nullIndex THEN
{ IF havePH THEN FinParse[];
RETURN[TRUE, answer, fromFieldErrorIndex];
};
AnalyzeAnswerTarget[ ! GVMailParse.ParseError => GO TO BadMessage];
make Subject field
outBuffer.PutRope["Subject: Re: "];
IF subjectIndex # nullIndex THEN
{ subject: ROPE; pos: INT← 0;
len: INT; foundRe: BOOL← FALSE;
getCharIndex ← subjectIndex;
InitParse[];
subject← GVMailParse.GetFieldBody[pH, GetNextChar];
FinParse[];
len← subject.Length[];
DO
np: INT← subject.Find["Re:", pos, FALSE];
IF np < 0 THEN EXIT;
foundRe← TRUE;
pos← np+3; -- skip over Re:
ENDLOOP;
IF foundRe AND (pos < len) THEN
WHILE subject.Fetch[pos] = SP DO pos← pos + 1; ENDLOOP;
outBuffer.PutRope[subject.Substr[pos]];
};
make In-reply-to field
outBuffer.PutRope["\nIn-reply-to: "];
IF idIndex = nullIndex THEN {
outBuffer.PutChar['"];
IF (IF answerTarget = reply THEN targetEqualsOrigin
ELSE (ccCount = 0 OR (replyerCCed AND ccCount = 1))) THEN
outBuffer.PutRope["Your"]
ELSE {
orLen: INT;
outBuffer.PutRope[originName];
IF (orLen← originRegistry.Length[]) # 0 THEN
{
outBuffer.PutChar['.];
outBuffer.PutRope[originRegistry];
};
outBuffer.PutChar[''];
IF orLen # 0 OR Ascii.Lower[originName.Fetch[originName.Length[] - 1]] # 's
THEN outBuffer.PutChar['s];
};
outBuffer.PutRope[" message of "];
InitParse[];
IF dateIndex # nullIndex THEN {getCharIndex ← dateIndex; FillField[]};
outBuffer.PutChar['"];
}
ELSE {
getCharIndex ← idIndex;
InitParse[];
FillField[];
};
FinParse[];
fill in target (To:) field of answer form
outBuffer.PutRope["\nTo: "];
ProcessAnswerTarget[];
fill in cc: field
outBuffer.PutRope[IF cForCopies THEN "\nc: " ELSE "\ncc: "];
IF answerTarget = reply THEN outBuffer.PutRope[userName]
ELSE ProcessFields[SecondPass ! GVMailParse.ParseError => GO TO BadMessage];
empty line at end of header
outBuffer.PutChar['\n];
answer← RopeFromROS[outBuffer];
EXITS
BadMessage => {
IF havePH THEN FinParse[];
answerError ← TRUE;
errorIndex← startOfHeaderLine};
};
RETURN[answerError, answer, errorIndex]
};
END.