-- File: AnswerImpl.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

DIRECTORY
Answer USING [Block],
Ascii USING [CR, SP],
Inline USING [LongCOPY],
MailParseDefs USING [
endOfInput, FinalizeParse, GetFieldBody, GetFieldName, InitializeParse,
maxFieldNameSize, maxRecipientLength, ParseError, ParseHandle, ParseNameList],
Storage USING [Free, FreeString, Node, String],
String USING [AppendChar, AppendString, EquivalentString, LowerCase];

AnswerImpl: PROGRAM
IMPORTS Inline, MailParseDefs, String, Storage
EXPORTS Answer =

BEGIN

-- Local Data Structures and Types

Buffer: TYPE = LONG STRING;
CharIndex: TYPE = CARDINAL;
nullIndex: CharIndex = LAST[CharIndex];

Name: TYPE = POINTER TO NameRecord;
NameRecord: TYPE = RECORD [simpleName, registry: STRING];

Qualification: TYPE = {unqualified, dotQualified};

DuplicateNameHandle: TYPE = POINTER TO DuplicateName;
DuplicateName: TYPE = RECORD
[next: DuplicateNameHandle,
seenOnSecondPass: BOOLEAN,
name: STRING];

-- Exported Procedure

MakeHeader: PUBLIC PROCEDURE
[getChar: PROCEDURE [CARDINAL] RETURNS [CHARACTER],
getLength: CARDINAL,
putBlock: PROCEDURE [Answer.Block],
getPages: PROCEDURE [CARDINAL] RETURNS [LONG POINTER],
freePages: PROCEDURE [LONG POINTER],
userName, userRegistry: STRING,
cForCopies: BOOLEAN ← FALSE]
RETURNS [answerError: BOOLEAN] =
BEGIN
getCharIndex, reStart: CharIndex;
pH: MailParseDefs.ParseHandle;
havePH: BOOLEAN ← FALSE;
buffer: Buffer ← NIL;
idIndex: CharIndex ← nullIndex;
dateIndex: CharIndex ← nullIndex;
subjectIndex: CharIndex ← nullIndex;

nameSize: CARDINAL = 60;

FieldIndex: TYPE =
{id, reply, sender, from, to, cc, c, bcc, date, subject}; -- order is significant!
knownField: ARRAY FieldIndex OF STRING =
["Message-ID"L, "Reply-to"L, "Sender"L, "From"L, "To"L, "cc"L, "c"L, "bcc"L,
"Date"L, "Subject"L]; -- order corresponds to FieldIndex
answerTarget: FieldIndex ← SUCC[from];

originSN: STRING = [MailParseDefs.maxRecipientLength];
originReg: STRING = [MailParseDefs.maxRecipientLength];
originPieces: NameRecord ← [originSN, originReg];
originName: Name = @originPieces;
originQual: Qualification;
originIndex: FieldIndex ← reply; -- anything except sender or from
answerTargetBodyCharIndex: CharIndex ← 0;

targetEqualsOrigin: BOOLEAN ← TRUE;

namesOutput: BOOLEAN ← FALSE;
replyerCCed: BOOLEAN ← FALSE;
ccCount: CARDINAL ← 0;
DuplicateHead: DuplicateNameHandle ← NIL;

AppendToBuffer: PROCEDURE [b: POINTER TO Buffer, char: CHARACTER] =
BEGIN
IF b.length >= b.maxlength THEN
BEGIN
pages: CARDINAL = ((b.maxlength + 4)/512) + 1;
temp: Buffer ← NewBuffer[pages];
Inline.LongCOPY[from: @b.text, to: @temp.text, nwords: b.maxlength/2];
temp.length ← b.length;
freePages[b↑];
b↑ ← temp;
END;
b[b.length] ← char;
b.length ← b.length + 1;
END; -- of AppendToBuffer --

AppendStringToBuffer: PROCEDURE [b: POINTER TO Buffer, s: STRING] =
BEGIN
IF s # NIL THEN FOR i: CARDINAL IN [0 .. s.length) DO
AppendToBuffer[b, s[i]];
ENDLOOP;
END; -- of AppendStringToBuffer --

DeleteRangeInBuffer: PROCEDURE [b: Buffer, from, to: CARDINAL] =
BEGIN
dif: CARDINAL = to - from;
b.length ← b.length - dif;
FOR i: CARDINAL IN [from..b.length) DO
b[i] ← b[i+dif];
ENDLOOP;
END; -- of DeleteRangeInBuffer --

NewBuffer: PROCEDURE [pages: CARDINAL] RETURNS [b: Buffer] =
BEGIN
b ← getPages[pages];
b↑ ← [length: 0, maxlength: pages*512 - 4, text: ];
END; -- of NewBuffer --

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

InitParse: PROCEDURE = {pH ← MailParseDefs.InitializeParse[GetNextChar]; havePH ← TRUE};

FinParse: PROCEDURE = {MailParseDefs.FinalizeParse[pH]; havePH ← FALSE};

StuffChar: PROCEDURE [char: CHARACTER] =
{IF char # Ascii.CR THEN [] ← AppendToBuffer[@buffer, char]};

ProcessFields: PROCEDURE [Inner: PROC [index: FieldIndex]] =
BEGIN OPEN MailParseDefs;
discardS: STRING = [0];
fieldName: STRING = [maxFieldNameSize];
getCharIndex ← 0;
InitParse[];
DO
IF ~GetFieldName[pH, fieldName] THEN EXIT;
FOR i: FieldIndex IN FieldIndex DO
IF String.EquivalentString[fieldName, knownField[i]] THEN {Inner[i]; EXIT};
REPEAT FINISHED => GetFieldBody[pH, discardS];
ENDLOOP;
ENDLOOP;
FinParse[];
END; -- of ProcessFields --

DetermineQualification: PROCEDURE [name: Name] RETURNS [Qualification] =
{RETURN[IF name.registry.length > 0 THEN dotQualified ELSE unqualified]};

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

ProcessName: PROCEDURE [simpleName, registry: STRING, isFile, ignored: BOOLEAN]
RETURNS [write: BOOLEAN] =
BEGIN
IF ~(originIndex = sender OR index = originIndex OR index = reply) THEN
BEGIN OPEN String;
originIndex ← index;
originName.simpleName.length ← originName.registry.length ← 0;
AppendString[originName.simpleName, simpleName];
AppendString[originName.registry, registry];
originQual ← DetermineQualification[originName];
originQual ← AdjustToReplyerContext[originName, originQual, isFile];
END;
IF index < answerTarget AND index # sender THEN
BEGIN
answerTarget ← index;
answerTargetBodyCharIndex ← fieldBodyStartIndex;
END;
RETURN[FALSE]
END; -- of ProcessName --

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

FirstPass: PROCEDURE [index: FieldIndex] =
BEGIN
discard: STRING ← [0];
SELECT index FROM
id => {idIndex ← getCharIndex; MailParseDefs.GetFieldBody[pH, discard]};
IN [reply .. from] => AnalyzeOrigin[index];
IN [to .. bcc] => FillNameField[firstPass: TRUE];
date => {dateIndex ← getCharIndex; MailParseDefs.GetFieldBody[pH, discard]};
subject => {subjectIndex ← getCharIndex; MailParseDefs.GetFieldBody[pH, discard]};
ENDCASE => MailParseDefs.GetFieldBody[pH, discard];
END; -- of FirstPass --

AdjustToSenderContext: PROCEDURE [name: Name] RETURNS [qual: Qualification] =
BEGIN
SELECT qual ← DetermineQualification[name] FROM
dotQualified =>
BEGIN
senderRegistry: STRING;
SELECT originQual FROM
unqualified => senderRegistry ← userRegistry;
dotQualified => senderRegistry ← originName.registry;
ENDCASE;
IF String.EquivalentString[name.registry, senderRegistry] THEN
{name.registry.length ← 0; qual ← unqualified};
END;
ENDCASE;
END; -- of AdjustToSenderContext --

AdjustToReplyerContext: PROCEDURE [name: Name, qual: Qualification, isFile: BOOLEAN]
RETURNS [newQual: Qualification] =
BEGIN
SELECT newQual ← qual FROM
unqualified =>
IF originQual = dotQualified AND ~isFile THEN
{newQual ← dotQualified; String.AppendString[name.registry, originName.registry]};
dotQualified =>
IF String.EquivalentString[name.registry, userRegistry] THEN
{newQual ← unqualified; name.registry.length ← 0};
ENDCASE;
END; -- of AdjustToReplyerContext --

FillField: PROCEDURE =
BEGIN
field: STRING = [124];
MailParseDefs.GetFieldBody[pH, field];
IF field.length > field.maxlength - 4 THEN
BEGIN
field.length ← field.maxlength - 4;
String.AppendString[field, " ..."L];
END;
AppendStringToBuffer[@buffer, field];
END; -- of FillField --

AddedToDuplicateList: PROCEDURE [name: Name, firstPass: BOOLEAN]
RETURNS [added: BOOLEAN] =
BEGIN
item: DuplicateNameHandle;
size: CARDINAL = name.simpleName.length
+ (IF name.registry.length # 0 THEN name.registry.length + 1 ELSE 0);
s: STRING ← Storage.String[size];
String.AppendString[s, name.simpleName];
IF name.registry.length # 0 THEN
{String.AppendChar[s, ’.]; String.AppendString[s, name.registry]};
FOR item ← DuplicateHead, item.next UNTIL item = NIL DO
IF String.EquivalentString[item.name, s] THEN
BEGIN
Storage.FreeString[s];
IF firstPass THEN RETURN[FALSE];
added ← ~item.seenOnSecondPass;
item.seenOnSecondPass ← TRUE;
RETURN
END;
ENDLOOP;
item ← Storage.Node[SIZE[DuplicateName]];
item.name ← s;
item.seenOnSecondPass ← FALSE;
item.next ← DuplicateHead;
DuplicateHead ← item;
RETURN[TRUE]
END; -- of AddedToDuplicateList --

ReleaseDuplicateList: PROCEDURE =
BEGIN
item: DuplicateNameHandle;
UNTIL DuplicateHead = NIL DO
item ← DuplicateHead.next;
Storage.FreeString[DuplicateHead.name];
Storage.Free[DuplicateHead];
DuplicateHead ← item;
ENDLOOP;
END; -- of ReleaseDuplicateList --

ProcessAnswerTarget: PROCEDURE =
BEGIN

ProcessName: PROCEDURE [simpleName, registry: STRING, isFile, ignored: BOOLEAN]
RETURNS [write: BOOLEAN] =
BEGIN
name: NameRecord ← [simpleName, registry];
qual: Qualification ← AdjustToSenderContext[@name];
[] ← AddedToDuplicateList[@name, FALSE];
[] ← AdjustToReplyerContext[@name, qual, isFile];
RETURN[TRUE];
END; -- of ProcessName --

getCharIndex ← answerTargetBodyCharIndex;
InitParse[];
MailParseDefs.ParseNameList[pH, ProcessName, StuffChar];
FinParse[];
END; -- of ProcessAnswerTarget --

AnalyzeAnswerTarget: PROCEDURE =
BEGIN

ProcessName: PROCEDURE [simpleName, registry: STRING, ignored1, ignored2: BOOLEAN]
RETURNS [write: BOOLEAN] =
BEGIN
name: NameRecord ← [simpleName, registry];
[] ← AdjustToSenderContext[@name];
targetEqualsOrigin ← targetEqualsOrigin
AND String.EquivalentString[simpleName, originName.simpleName]
AND String.EquivalentString[registry, originName.registry];
IF ~AddedToDuplicateList[@name, TRUE] THEN ccCount ← ccCount - 1;
RETURN[FALSE];
END; -- of ProcessName --

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

FillNameField: PROCEDURE [firstPass: BOOLEAN] =
BEGIN
firstOutput: BOOLEAN ← TRUE;

ProcessName: PROCEDURE [simpleName, registry: STRING, isFile, nested: BOOLEAN]
RETURNS [write: BOOLEAN] =
BEGIN
name: NameRecord ← [simpleName, registry];
qual: Qualification ← AdjustToSenderContext[@name];
new: BOOLEAN ← AddedToDuplicateList[@name, firstPass];
IF ~nested AND ~new THEN RETURN[FALSE];
[] ← AdjustToReplyerContext[@name, qual, isFile];
IF firstPass THEN
BEGIN
ccCount ← ccCount + 1;
IF ~replyerCCed AND String.EquivalentString[simpleName, userName]
AND registry.length = 0 THEN replyerCCed ← TRUE;
RETURN[FALSE]
END;
IF firstOutput THEN
BEGIN
firstOutput ← FALSE;
IF namesOutput THEN {StuffChar[’,]; StuffChar[Ascii.SP]}
END;
RETURN[namesOutput ← TRUE]
END; -- of ProcessName --

MailParseDefs.ParseNameList[pH, ProcessName, StuffChar];
END; -- of FillNameField --

SecondPass: PROCEDURE [index: FieldIndex] =
BEGIN
discard: STRING = [0];
SELECT index FROM
IN [to .. bcc] => FillNameField[firstPass: FALSE];
ENDCASE => MailParseDefs.GetFieldBody[pH, discard];
END; -- of SecondPass --

PutBuffer: PROCEDURE =
BEGIN
AppendToBuffer[@buffer, Ascii.CR];
putBlock[[@buffer.text, buffer.length]];
buffer.length ← 0;
END; -- of PutBuffer --

-- main body of AnswerImpl

answerError ← FALSE;
buffer ← NewBuffer[1];

BEGIN

-- find out who it’s from and where the interesting indices are
ProcessFields[FirstPass ! MailParseDefs.ParseError => GO TO BadMessage];
AnalyzeAnswerTarget[ ! MailParseDefs.ParseError => GO TO BadMessage];

-- make Subject field
AppendStringToBuffer[@buffer, "Subject: Re: "L];
IF subjectIndex # nullIndex THEN
{getCharIndex ← subjectIndex; InitParse[]; FillField[]; FinParse[]};
reStart ← 13;
WHILE (buffer.length > reStart + 2)
AND (String.LowerCase[buffer[reStart]] = ’r) AND (String.LowerCase[buffer[reStart+1]] = ’e)
AND (buffer[reStart+2] = ’:) DO
DeleteRangeInBuffer[buffer, reStart, reStart + 3];
WHILE buffer.length > reStart AND buffer[reStart] = Ascii.SP DO
DeleteRangeInBuffer[buffer, reStart, reStart + 1];
ENDLOOP;
ENDLOOP;
PutBuffer[];

-- make In-reply-to field
AppendStringToBuffer[@buffer, "In-reply-to: "L];
IF idIndex = nullIndex THEN
BEGIN
StuffChar[’"];
IF (IF answerTarget = reply THEN targetEqualsOrigin
ELSE (ccCount = 0 OR (replyerCCed AND ccCount = 1))) THEN
AppendStringToBuffer[@buffer, "Your"L]
ELSE BEGIN
AppendStringToBuffer[@buffer, originSN];
IF originReg.length ~= 0 THEN
BEGIN
AppendToBuffer[@buffer, ’.];
AppendStringToBuffer[@buffer, originReg];
END;
AppendToBuffer[@buffer, ’’];
IF originReg.length # 0 OR String.LowerCase[originSN[originSN.length - 1]] ~= ’s
THEN AppendToBuffer[@buffer, ’s];
END;
AppendStringToBuffer[@buffer, " message of "L];
InitParse[];
IF dateIndex # nullIndex THEN {getCharIndex ← dateIndex; FillField[]};
StuffChar[’"];
END
ELSE BEGIN
getCharIndex ← idIndex;
InitParse[];
FillField[];
END;
FinParse[];
PutBuffer[];

-- fill in target (To:) field of answer form
AppendStringToBuffer[@buffer, "To: "L];
ProcessAnswerTarget[];
PutBuffer[];

-- fill in cc: field
AppendStringToBuffer[@buffer, IF cForCopies THEN "c: "L ELSE "cc: "L];
IF answerTarget = reply THEN AppendStringToBuffer[@buffer, userName]
ELSE ProcessFields[SecondPass ! MailParseDefs.ParseError => GO TO BadMessage];
PutBuffer[];

-- empty line at end of header
PutBuffer[];

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

freePages[buffer];
ReleaseDuplicateList[];

RETURN[answerError]
END; -- of MakeHeader --


END. -- AnswerImpl --