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;


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;



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;
parseErrorEncountered: BOOL _ FALSE;
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] RETURNS[parseError: BOOL] ]  RETURNS[errorSeen: BOOL] = { OPEN GVMailParse;
fieldName: ROPE;
found: BOOL;
getCharIndex _ 0;
InitParse[];
errorSeen _ FALSE;
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 {
IF Inner[i] THEN errorSeen _ TRUE;
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 OR (index = from AND answerTarget = sender) THEN {
answerTarget _ index;
answerTargetBodyCharIndex _ fieldBodyStartIndex;
};
RETURN[NIL, FALSE]
}; -- of ProcessName --

GVMailParse.ParseNameList[pH, GetNextChar, ProcessName
! GVMailParse.ParseError => {
IF index = from THEN fromFieldErrorIndex _ fieldBodyStartIndex
ELSE errorIndex _ fieldBodyStartIndex;
[]_ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE];
CONTINUE;
}];
}; -- of AnalyzeOrigin --

FirstPass: PROC [index: FieldIndex] RETURNS[parseError: BOOL] = {
parseError _ FALSE;
SELECT index FROM
id => {
idIndex _ getCharIndex;
[]_ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE]
};
IN [reply .. from] => AnalyzeOrigin[index];
IN [to .. bcc] => IF FillNameField[firstPass: TRUE] THEN parseError _ 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 ! GVMailParse.ParseError => {
[] _ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE];
CONTINUE }];
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 => {
	[] _ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE];
	answerError _ TRUE;
	CONTINUE }];
FinParse[];
}; -- of AnalyzeAnswerTarget --

FillNameField: PROC [firstPass: BOOL] RETURNS[parseError: BOOL] = {
lineIndex: INT _ getCharIndex;
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 --
parseError _ FALSE;
GVMailParse.ParseNameList[pH, GetNextChar, ProcessName, StuffChar !
GVMailParse.ParseError => {
[] _ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE];
parseError _ TRUE;
errorIndex _ lineIndex;
CONTINUE;
};
];
}; -- of FillNameField --

SecondPass: PROC [index: FieldIndex] RETURNS[parseError: BOOL]=
{
SELECT index FROM
IN [to .. bcc] => [] _ FillNameField[firstPass: FALSE];
ENDCASE => []_ GVMailParse.GetFieldBody[pH, GetNextChar, TRUE];
RETURN[FALSE];
}; -- of SecondPass --


answerError _ FALSE;
errorIndex_ nullIndex;
outBuffer_ ROS[];

{

answerError _ 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];

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]];
};

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[];

outBuffer.PutRope["\nTo: "];
ProcessAnswerTarget[];

outBuffer.PutRope[IF cForCopies THEN "\nc:  " ELSE "\ncc: "];
IF answerTarget = reply THEN outBuffer.PutRope[userName]
ELSE [] _ ProcessFields[SecondPass ! GVMailParse.ParseError => GO TO BadMessage];

outBuffer.PutChar['\n];
answer_ RopeFromROS[outBuffer];

EXITS
BadMessage => {
IF havePH THEN FinParse[];
answerError _ TRUE;
errorIndex_ startOfHeaderLine};
};

RETURN[answerError, answer, errorIndex]
};

END.
LGVAnswerImpl.mesa
Copyright c 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, July 28, 1986 11:11:46 am PDT
Doug Wyatt, March 7, 1985 11:12:37 am PST
Russ Atkinson (RRA) March 21, 1985 1:35:15 am PST
Local Data Structures and Types
Exported Procedure
main body of AnswerImpl
find out who it's from and where the interesting indices are
make Subject field
make In-reply-to field
fill in target (To:) field of answer form
fill in cc: field
empty line at end of header
Κ:˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ)™)Kš
œ™Kš
œ™Kš
œ)™)K™)K™1—K˜š
Οk	˜	Kšœžœ	˜K˜	Kšœžœr˜ƒ
Kšžœ
˜K˜K˜—šΠblœžœ
ž˜Kšžœžœ˜$Kšžœ	˜Kšœžœ
žœ
žœ
˜—K˜š
œ™K˜Kšžœžœžœ
˜Kšœžœžœ
˜Kšœžœ˜'K˜šœžœ˜2K˜—Kš	œžœžœžœžœ˜HKšœžœžœ˜.K˜K˜—š
œ™K˜—šΟn
œžœ
žœ
žœžœžœžœžœžœžœžœ
žœžœ
žœžœ˜Β
Kšœžœ
žœ
˜K˜K˜Kšœžœžœ
˜K˜K˜!K˜$K˜+K˜)Kšœžœžœ
˜$Kš
 	œžœžœžœžœ˜KK˜šœžœ˜Kšœ:Οc˜R—šœžœžœ
žœ˜&K˜DKšœ‘"˜6—Kšœžœ˜&K˜Kšœžœ
˜!K˜Kšœ!‘!˜B˜1K˜—šœžœžœ
˜ K˜—Kšœ
žœžœ
˜Kšœ
žœžœ
˜Kšœ	žœ˜Kšœžœ
žœ˜%K˜š œžœ
žœžœ˜*Kšžœžœ
žœ˜BKš
œ˜K˜ Kš
œ˜—K˜Kš 	œžœ1žœ˜FK˜Kš œžœ,žœ˜AK˜š 
œžœ œžœžœ
žœžœžœžœ
˜€
Kšœžœ
˜Kšœžœ
˜K˜K˜Kšœžœ
˜š
ž˜Kš
œ
˜
K˜ ˜Kšœ9žœ˜H—Kšžœžœ
žœ
˜šžœžœž˜"šžœ žœžœ˜/Kšžœ
žœ
žœ
˜"Kšžœ˜—Kšžœ
žœ&žœ˜;Kšžœ
˜—š
ž˜š
œ˜š
ž˜šžœž˜Kšœžœ
˜$Kšžœ
˜—Kšžœ
˜———Kš
œ˜—Kšžœ
˜K˜Kšœ‘˜—K˜š 
œžœ˜+K˜.š œžœžœžœ
˜EKšžœžœ	žœ˜$šžœžœžœžœ˜IK˜K˜K˜Kšœžœžœžœ
˜N˜K˜G—Kš
œ˜—šžœžœžœžœ˜JK˜K˜0Kš
œ˜—Kšžœ
žœžœ
˜Kšœ‘˜—K˜˜6š
œ˜šžœžœ*˜>Kšžœ"˜&—Kšœ.žœ˜4Kš
ž	˜	Kš
œ˜——Kšœ‘˜—K˜š 	œžœžœ
žœ˜AKšœ
žœ
˜šžœž˜š
œ˜Kš
œ˜Kšœ.žœ
˜3Kš
œ˜—Kšžœ)˜+Kš
žœžœžœžœžœ
˜Kš
œ	˜	Kš
œ˜Kšœ.žœ
˜3Kš
œ˜—˜Kš
œ˜Kšœ.žœ
˜3Kš
œ˜—Kšžœ2žœ˜?—šœ‘˜K˜——K˜š œžœžœ
˜1Kšžœžœ˜+K˜š	žœžœžœžœ
ž˜Mš
œ˜Kšœžœ
˜šžœž˜K˜-K˜0Kšžœ
˜—šžœ žœž˜-Kšœžœ˜—Kš
œ˜—Kšžœ
˜—Kšœ‘˜!—K˜š œžœžœžœ
˜VKšžœžœ˜/K˜šžœž˜˜šžœžœ	ž˜-K˜-K˜—šžœžœž˜+Kšœžœ˜!Kšžœ
˜———Kšœ‘˜"—K˜š 	œžœ˜Kšœžœ,˜7šžœžœ
‘+˜HK˜EKšžœ˜—Kšœ‘˜—K˜š œžœžœ
žœ
˜HKšžœ	žœ˜Kšœžœ
˜Kšžœžœ˜6šžœžœ
žœ*žœ	žœ
ž˜Pšžœ!žœžœ˜0Kšžœžœ
žœ
žœ˜ K˜&Kšœžœ
˜$Kš
ž˜Kš
œ˜—Kšžœ
˜—˜Kšžœ
žœ2žœ˜R—Kšžœ
žœ
˜Kšœ‘˜ —K˜š œžœ˜š œžœžœžœ
˜EKšžœžœ	žœ˜$K˜K˜9Kšœ*žœ˜1K˜@Kšžœžœ˜Kšœ‘˜—K˜K˜)K˜š
œ_˜_Kšœ/žœ˜5Kšžœ˜—K˜Kšœ‘˜—K˜š œžœ˜š œžœžœžœ
˜HKšžœžœ	žœ˜$K˜7˜&Kšžœžœ
˜'šžœžœžœ˜;Kšžœ(žœžœ˜KKšžœ
žœžœ˜Kšœ‘˜———K˜Kšžœžœ
žœ&˜QK˜)K˜š
œU˜UKšœ0žœ˜6Kšœžœ
˜Kšœ
žœ˜
—K˜Kšœ‘˜—K˜š
 
œžœ
žœžœ
žœ˜CKšœžœ˜Kšœ
žœžœ
˜š œžœžœžœ
˜DKšžœžœ	žœ˜$K˜Kšœžœ
˜
K˜:K˜7Kšžœ	žœžœ
žœ
žœžœ˜,K˜Ašžœž˜Kš
œ
˜
K˜šžœžœžœ
˜5Kšžœžœžœ
˜-—Kšžœ
žœžœ
˜š
œ˜šžœ
ž˜š
œ
˜
Kšœžœ
˜Kšžœ
žœ˜,—Kš
œ˜———Kšžœžœ˜ Kšœ‘˜—Kšœ
žœ
˜š
œC˜Cš
œ˜Kšœ/žœ˜5Kšœ
žœ
˜Kš
œ˜Kšžœ
˜	K˜K˜——Kšœ‘˜—K˜š 
œžœžœ
žœ˜?Kš
œ
˜
šžœž˜Kšžœ.žœ˜7Kšžœ2žœ˜?—Kšžœ
žœ˜Kšœ‘˜—K˜Kš
œ™K˜Kšœžœ
˜K˜Kšœžœ˜K˜š
œ
˜
K˜—Kš
œ<™<KšœBžœ
žœ
˜Tšžœ'ž˜-šœžœžœ˜Kšžœ
žœ˜*—K˜—Kšœ1žœ
žœ
˜CK˜Kš
œ™K˜#šžœž˜ šœžœžœ˜Kšœžœžœžœ
˜K˜K˜K˜3K˜K˜š
ž˜Kšœžœžœ˜)Kšžœžœ
žœ
˜Kšœ	žœ
˜Kšœ‘˜Kšžœ
˜—šžœ	žœ
ž˜Kšžœžœ
žœžœ
˜7—K˜'—K˜—K˜Kš
œ™K˜%šžœžœ˜K˜šžœžœžœ˜3Kšžœžœžœž˜9K˜—šžœ˜Kšœžœ
˜K˜šžœ&ž˜,Kš
œ
˜
K˜K˜"Kš
œ˜—K˜šžœžœ<˜KKšžœ˜—Kš
œ˜—K˜"K˜Kšžœžœ)˜FK˜Kš
œ
˜
—šžœ˜K˜K˜K˜Kš
œ˜—K˜K˜Kš
œ)™)K˜K˜K˜Kš
œ™Kšœžœžœ
žœ˜=Kšžœžœ˜8Kšžœ;žœ
žœ
˜QK˜Kš
œ™K˜K˜K˜š
ž˜š
œ˜Kšžœžœ˜Kšœžœ
˜Kš
œ˜——Kš
œ˜K˜Kšžœ!˜'Kš
œ˜—K˜Kšžœ
˜—…—*Δ;J