-- File: GVAnswerImpl.Mesa
-- edited by Karlton, Friday Feb. 13, 1981 6:10 pm PST
-- edited by Levin, March 4, 1983 2:08 PM
-- edited by Brotz, March 4, 1983 12:02 PM
-- Last Edited by: Willie-sue, September 14, 1983 11:27 am

DIRECTORY
GVAnswer,
GVMailParse USING [
endOfInput, FinalizeParse, GetFieldBody, GetFieldName, InitializeParse,
ParseError, ParseHandle, ParseNameList],
IO,
Rope;

GVAnswerImpl: CEDAR PROGRAM
IMPORTS 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;

outBuffer: IO.STREAM;

-- 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] =
BEGIN
getCharIndex: CharIndex;
pH: GVMailParse.ParseHandle;
havePH: BOOL ← FALSE;
idIndex: CharIndex ← nullIndex;
dateIndex: CharIndex ← nullIndex;
subjectIndex: CharIndex ← nullIndex;

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 ← 0;

targetEqualsOrigin: BOOL ← TRUE;

namesOutput: BOOL ← FALSE;
replyerCCed: BOOL ← FALSE;
ccCount: CARDINAL ← 0;
DuplicateHead: LIST OF DuplicateName;

GetNextChar: PROC RETURNS [char: CHAR] =
BEGIN
char ←
IF getCharIndex >= getLength THEN GVMailParse.endOfInput ELSE getChar[getCharIndex];
getCharIndex ← getCharIndex + 1;
END; -- of GetNextChar --

InitParse: PROC = {pH ← GVMailParse.InitializeParse[]; havePH ← TRUE};

FinParse: PROC = {GVMailParse.FinalizeParse[pH]; havePH ← FALSE};

ProcessFields: PROC [Inner: PROC [index: FieldIndex]] =
BEGIN OPEN GVMailParse;
fieldName: ROPE;
found: BOOL;
getCharIndex ← 0;
InitParse[];
DO
[fieldName, found]← GetFieldName[pH, GetNextChar];
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;
ENDLOOP;
FinParse[];
END; -- of ProcessFields --

AnalyzeOrigin: PROC [index: FieldIndex] =
BEGIN
fieldBodyStartIndex: CharIndex = getCharIndex;

ProcessName: PROC [simpleName, registry: ROPE, isFile, ignored: BOOL]
RETURNS [reg: ROPE, write: BOOL] =
BEGIN
IF ~(originIndex = sender OR index = originIndex OR index = reply) THEN
BEGIN
originIndex ← index;
originName← simpleName;
originRegistry← registry;
originQual← IF originRegistry.Length[] > 0 THEN dotQualified ELSE unqualified;
[originQual, originRegistry]←
  AdjustToReplyerContext[originName, originRegistry, originQual, isFile];
END;
IF index < answerTarget AND index # sender THEN
BEGIN
answerTarget ← index;
answerTargetBodyCharIndex ← fieldBodyStartIndex;
END;
RETURN[NIL, FALSE]
END; -- of ProcessName --

GVMailParse.ParseNameList[pH, GetNextChar, ProcessName];
END; -- of AnalyzeOrigin --

FirstPass: PROC [index: FieldIndex] =
BEGIN
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];
END; -- of FirstPass --

AdjustToSenderContext: PROC[name, registry: ROPE] RETURNS[qual: Qualification, reg: ROPE] =
BEGIN
reg← registry;
SELECT qual← IF registry.Length[] > 0 THEN dotQualified ELSE unqualified FROM
dotQualified =>
BEGIN
senderRegistry: ROPE;
SELECT originQual FROM
unqualified => senderRegistry ← userRegistry;
dotQualified => senderRegistry ← originRegistry;
ENDCASE;
IF registry.Equal[senderRegistry, FALSE] THEN
{reg← NIL; qual ← unqualified}
END;
ENDCASE;
END; -- of AdjustToSenderContext --

AdjustToReplyerContext: PROC [name, registry: ROPE, qual: Qualification, isFile: BOOL]
  RETURNS [newQual: Qualification, reg: ROPE] =
BEGIN
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;
END; -- of AdjustToReplyerContext --

FillField: PROC =
BEGIN
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];
END; -- of FillField --

AddedToDuplicateList: PROC [simpleName, registry: ROPE, firstPass: BOOL]
  RETURNS [added: BOOL] =
BEGIN
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
BEGIN
IF firstPass THEN RETURN[FALSE];
added ← ~itemL.first.seenOnSecondPass;
itemL.first.seenOnSecondPass ← TRUE;
RETURN
END;
ENDLOOP;
DuplicateHead←
CONS[NEW[DuplicateNameRecord← [name: s, seenOnSecondPass: FALSE]], DuplicateHead];
RETURN[TRUE]
END; -- of AddedToDuplicateList --

ProcessAnswerTarget: PROC =
BEGIN

ProcessName: PROC [simpleName, registry: ROPE, isFile, ignored: BOOL]
RETURNS [reg: ROPE, write: BOOL] =
BEGIN
qual: Qualification;
[qual, reg]← AdjustToSenderContext[simpleName, registry];
[]← AddedToDuplicateList[simpleName, reg, FALSE];
[ , reg]← AdjustToReplyerContext[simpleName, reg, qual, isFile];
RETURN[reg, TRUE];
END; -- of ProcessName --
 
getCharIndex ← answerTargetBodyCharIndex;
InitParse[];
GVMailParse.ParseNameList[pH, GetNextChar, ProcessName, StuffChar];
FinParse[];
END; -- of ProcessAnswerTarget --

AnalyzeAnswerTarget: PROC =
BEGIN

ProcessName: PROC [simpleName, registry: ROPE, ignored1, ignored2: BOOL]
RETURNS [reg: ROPE, write: BOOL] =
BEGIN
 [ , 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];
 END; -- of ProcessName --

IF answerTargetBodyCharIndex = 0 THEN ERROR GVMailParse.ParseError[badFieldName];
getCharIndex ← answerTargetBodyCharIndex;
InitParse[];
GVMailParse.ParseNameList
[pH, GetNextChar, ProcessName, ! GVMailParse.ParseError => answerError ← TRUE];
FinParse[];
END; -- of AnalyzeAnswerTarget --

FillNameField: PROC [firstPass: BOOL] =
BEGIN
 firstOutput: BOOL← TRUE;

ProcessName: PROC [simpleName, registry: ROPE, isFile, nested: BOOL]
RETURNS [reg: ROPE, write: BOOL] =
BEGIN
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
BEGIN
ccCount ← ccCount + 1;
IF ~replyerCCed AND simpleName.Equal[userName, FALSE]
AND reg.Length[] = 0 THEN replyerCCed ← TRUE;
RETURN[NIL, FALSE]
END;
  IF firstOutput THEN
  BEGIN
  firstOutput ← FALSE;
  IF namesOutput THEN outBuffer.PutRope[", "];
  END;
RETURN[reg, namesOutput← TRUE];
END; -- of ProcessName --
 
GVMailParse.ParseNameList[pH, GetNextChar, ProcessName, StuffChar];
END; -- of FillNameField --

SecondPass: PROC [index: FieldIndex] =
BEGIN
SELECT index FROM
IN [to .. bcc] => FillNameField[firstPass: FALSE];
ENDCASE => []← GVMailParse.GetFieldBody[pH, GetNextChar, TRUE];
END; -- of SecondPass --

-- main body of AnswerImpl

answerError ← FALSE;
errorIndex← nullIndex;
outBuffer← CreateOutputStreamToRope[];

BEGIN

-- find out who it's from and where the interesting indices are
ProcessFields[FirstPass ! GVMailParse.ParseError => GO TO BadMessage];
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
BEGIN
outBuffer.PutChar['"];
IF (IF answerTarget = reply THEN targetEqualsOrigin
ELSE (ccCount = 0 OR (replyerCCed AND ccCount = 1))) THEN
outBuffer.PutRope["Your"]
ELSE BEGIN
orLen: INT;
outBuffer.PutRope[originName];
IF (orLen← originRegistry.Length[]) # 0 THEN
BEGIN
outBuffer.PutChar['.];
outBuffer.PutRope[originRegistry];
END;
outBuffer.PutChar[''];
IF orLen # 0 OR Rope.Lower[originName.Fetch[originName.Length[] - 1]] # 's
THEN outBuffer.PutChar['s];
END;
outBuffer.PutRope[" message of "];
InitParse[];
IF dateIndex # nullIndex THEN {getCharIndex ← dateIndex; FillField[]};
outBuffer.PutChar['"];
END
ELSE BEGIN
getCharIndex ← idIndex;
InitParse[];
FillField[];
END;
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← GetOutputStreamRope[outBuffer];
outBuffer.Close[];

EXITS
BadMessage => {IF havePH THEN FinParse[]; answerError ← TRUE; errorIndex← getCharIndex};
END;

RETURN[answerError, answer, errorIndex]
END; -- of MakeHeader --

-- can't be internal to MakeHeader
StuffChar: PROC[char: CHAR] = {IF char # '\n THEN outBuffer.PutChar[char]};

END. -- GVAnswerImpl --