-- File: GVAnswerImpl.Mesa
-- based on [Juniper]<DMS>Laurel>6T30>IntAnswerCom.mesa
-- edited by Karlton, Friday Feb. 13, 1981 6:10 pm PST
-- edited by Levin, 29-Mar-82 9:34:23

-- edited by Willie-Sue on: January 21, 1983 10:43 am

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

GVAnswerImpl: CEDAR PROGRAM
IMPORTS GVMailParse, Rope
EXPORTS GVAnswer =

BEGIN

-- Local Data Structures and Types

ROPE: TYPE = Rope.ROPE;
CharIndex: TYPE = INT;
nullIndex: CharIndex = LAST[CharIndex];

Name: TYPE = REF NameRecord;
NameRecord: TYPE = RECORD [simpleName, registry, arpaHost: ROPE];

Qualification: TYPE = {unqualified, dotQualified, arpaQualified};

DuplicateNameHandle: TYPE = REF DuplicateName;
DuplicateName: TYPE = RECORD [
next: DuplicateNameHandle, seenOnSecondPass: BOOLEAN, name: ROPE];

-- Exported Procedures

MakeHeader: PUBLIC PROCEDURE [
getChar: PROCEDURE [INT] RETURNS [CHARACTER],
getLength: INT,
userName, userRegistry: ROPE,
arpaGatewayHostNames: LIST OF ROPE,
cForCopies: BOOLEAN ← FALSE]
   RETURNS [answerError: BOOLEAN, answer: ROPE] =
BEGIN
getCharIndex, reStart: CharIndex;
pH: GVMailParse.ParseHandle;
havePH: BOOLEAN ← FALSE;
idIndex: CharIndex ← nullIndex;
dateIndex: CharIndex ← nullIndex;
subjectIndex: CharIndex ← nullIndex;

 rp: ROPE; rLen: INT;

PutIndex: TYPE = {subject, inreply, to, cc}; -- order is significant!
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: Name = NEW[NameRecord← [NIL, NIL, NIL]];
originQual: Qualification;
originIndex: FieldIndex ← reply; -- anything except sender or from
answerTargetBodyCharIndex: CharIndex ← 0;

defaultRegistry: ROPE = "pa";
replyerRegIsDefault: BOOLEAN = Rope.Equal[userRegistry, defaultRegistry, FALSE];
targetEqualsOrigin: BOOLEAN ← TRUE;

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

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

BackupChar: PROCEDURE = {getCharIndex ← getCharIndex - 1};

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

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

ProcessFields: PROCEDURE [Inner: PROC [index: FieldIndex]] =
BEGIN OPEN GVMailParse;
fieldName: ROPE;
  found: BOOL;
getCharIndex ← 0;
InitParse[];
DO
  [found, fieldName]← GetFieldName[pH];
  IF ~found THEN EXIT;
  FOR i: FieldIndex IN FieldIndex DO
    IF Rope.Equal[fieldName, knownField[i], FALSE] THEN {Inner[i]; EXIT};
   REPEAT FINISHED => []← GetFieldBody[pH];
   ENDLOOP;
  ENDLOOP;
FinParse[];
END; -- of ProcessFields --

DetermineQualification: PROCEDURE [name: Name] RETURNS [Qualification] =
BEGIN
RETURN[
  SELECT TRUE FROM
   name.arpaHost.Length[] > 0 => arpaQualified,
   name.registry.Length[] > 0 => dotQualified,
   ENDCASE => unqualified]
END; -- of DetermineQualification --

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

ProcessName: PROCEDURE [
  simpleName, registry, arpaHost: ROPE, ignored: GVMailParse.NameInfo]
  RETURNS [accept: BOOLEAN] =
  BEGIN
  IF ~(originIndex = sender OR index = originIndex OR index = reply) THEN
   BEGIN
   originIndex ← index;
   originName.simpleName← simpleName;
   originName.registry← registry;
   originName.arpaHost← arpaHost;
   originQual ← DetermineQualification[originName];
   originQual ← AdjustToReplyerContext[originName, originQual];
   END;
  IF index < answerTarget AND
   ~(originQual = arpaQualified AND index = sender) THEN
   BEGIN
   answerTarget ← index;
   answerTargetBodyCharIndex ← fieldBodyStartIndex;
   END;
  RETURN[FALSE]
  END; -- of ProcessName --
 
GVMailParse.ParseNameList[pH, ProcessName];
END; -- of AnalyzeOrigin --

GetOrigin: PROCEDURE [index: FieldIndex] =
BEGIN
SELECT index FROM
  IN [reply..from] => AnalyzeOrigin[index];
  ENDCASE => []← GVMailParse.GetFieldBody[pH];
RETURN
END; -- of GetOrigin --

FirstPass: PROCEDURE [index: FieldIndex] =
BEGIN
SELECT index FROM
  id => {idIndex ← getCharIndex; []← GVMailParse.GetFieldBody[pH]};
  IN [to..bcc] => FillNameField[firstPass: TRUE];
  date => {dateIndex ← getCharIndex; []← GVMailParse.GetFieldBody[pH]};
  subject => {subjectIndex ← getCharIndex; []← GVMailParse.GetFieldBody[pH]};
  ENDCASE => []← GVMailParse.GetFieldBody[pH];
RETURN
END; -- of FirstPass --

LocalArpaSite: PROCEDURE [host: ROPE] RETURNS [BOOLEAN] =
BEGIN
FOR l: LIST OF ROPE← arpaGatewayHostNames, l.rest UNTIL l=NIL DO
  IF Rope.Equal[host, l.first, FALSE] THEN RETURN[TRUE];
  ENDLOOP;
RETURN[FALSE]
END; -- of LocalArpaSite --

AdjustToSenderContext: PROCEDURE [name: Name] RETURNS [qual: Qualification] =
BEGIN
DO
 -- loops only if name has local Arpa qualification and originator is local as well.
  SELECT qual ← DetermineQualification[name] FROM
   unqualified => EXIT;
   dotQualified =>
   BEGIN
   senderRegistry: ROPE;
   SELECT originQual FROM
   unqualified => senderRegistry ← userRegistry;
   dotQualified => senderRegistry ← originName.registry;
   arpaQualified => EXIT;
   ENDCASE;
   IF Rope.Equal[name.registry, senderRegistry, FALSE] THEN
   BEGIN name.registry← NIL; qual ← unqualified; END;
   EXIT
   END;
   arpaQualified =>
   BEGIN
   nameIsLocalArpa: BOOLEAN = LocalArpaSite[name.arpaHost];
   IF nameIsLocalArpa AND name.registry.Length[] = 0 AND
   ~replyerRegIsDefault THEN name.registry← defaultRegistry;
   IF originQual ~= arpaQualified THEN
   IF nameIsLocalArpa THEN name.arpaHost← NIL -- and LOOP
   ELSE EXIT
   ELSE
   BEGIN
   IF Rope.Equal[name.arpaHost, originName.arpaHost, FALSE] THEN {
    name.arpaHost← NIL; qual ← DetermineQualification[name]};
   EXIT
   END;
   END;
   ENDCASE;
  ENDLOOP;
END; -- of AdjustToSenderContext --

AdjustToReplyerContext: PROCEDURE [name: Name, qual: Qualification]
RETURNS [newQual: Qualification] =
BEGIN
SELECT newQual ← qual FROM
  unqualified =>
   SELECT newQual ← originQual FROM
   dotQualified =>
   SELECT name.simpleName.Fetch[0] FROM
    '@, '" => NULL;
    ENDCASE => name.registry← originName.registry;
   arpaQualified => GO TO AddOriginHost;
   ENDCASE;
  dotQualified =>
   SELECT originQual FROM
   unqualified, dotQualified => GO TO CheckEqualNA;
   arpaQualified => BEGIN newQual ← originQual; GO TO AddOriginHost END;
   ENDCASE;
  arpaQualified =>
   IF LocalArpaSite[name.arpaHost] THEN
   BEGIN
   name.arpaHost← NIL;
   newQual ← qual ← DetermineQualification[name];
   IF qual = dotQualified THEN GO TO CheckEqualNA;
   END;
  ENDCASE;
EXITS
 AddOriginHost => name.arpaHost← originName.arpaHost;
 CheckEqualNA =>
  IF Rope.Equal[name.registry, userRegistry, FALSE] THEN
  BEGIN newQual ← unqualified; name.registry← NIL; END;
END; -- of AdjustToReplyerContext --

FillField: PROC RETURNS[field: ROPE] =
BEGIN
-- field: STRING = [124];
field← GVMailParse.GetFieldBody[pH];
IF field.Length[] > 124 - 4 THEN
  field← Rope.Concat[Rope.Substr[field, 0, 120], " ..."];
END; -- of FillField --

AddedToDuplicateList: PROCEDURE [name: Name, firstPass: BOOLEAN]
RETURNS [added: BOOLEAN] =
BEGIN
item: DuplicateNameHandle;
  rp: ROPE← name.simpleName;
IF name.registry.Length[] # 0 THEN rp← Rope.Cat[rp, ".", name.registry];
IF name.arpaHost.Length[] # 0 THEN rp← Rope.Cat[rp, "@", name.arpaHost];
FOR item ← DuplicateHead, item.next UNTIL item = NIL DO
  IF Rope.Equal[item.name, rp, FALSE] THEN
   BEGIN
   IF firstPass THEN RETURN[FALSE];
   added ← ~item.seenOnSecondPass;
   item.seenOnSecondPass ← TRUE;
   RETURN
   END;
  ENDLOOP;
DuplicateHead←
   NEW[DuplicateName← [name: rp, seenOnSecondPass: FALSE, next: DuplicateHead]];
RETURN[TRUE]
END; -- of AddedToDuplicateList --

ProcessAnswerTarget: PROCEDURE =
BEGIN

ProcessName: PROCEDURE [
  simpleName, registry, arpaHost: ROPE, ignored: GVMailParse.NameInfo]
  RETURNS [accept: BOOLEAN] =
  BEGIN
  name: REF NameRecord← NEW[NameRecord ← [simpleName, registry, arpaHost]];
  qual: Qualification ← AdjustToSenderContext[name];
  [] ← AddedToDuplicateList[name, FALSE];
  [] ← AdjustToReplyerContext[name, qual];
  RETURN[TRUE];
  END; -- of ProcessName --
  rp: ROPE← "";
  AccumulateName: PROC[ch: CHAR] =
  { IF ch#'\n THEN rp← Rope.Concat[rp, Rope.FromChar[ch]]};

getCharIndex ← answerTargetBodyCharIndex;
InitParse[];
GVMailParse.ParseNameList[pH, ProcessName, AccumulateName, TRUE];
FinParse[];
  IF rp.Length[]#0 THEN answer← Rope.Concat[answer, Rope.Flatten[rp]];
END; -- of ProcessAnswerTarget --

AnalyzeAnswerTarget: PROCEDURE =
BEGIN

ProcessName: PROCEDURE [
  simpleName, registry, arpaHost: ROPE, ignored: GVMailParse.NameInfo]
  RETURNS [accept: BOOLEAN] =
  BEGIN
  name: REF NameRecord← NEW[NameRecord← [simpleName, registry, arpaHost]];
  qual: Qualification ← AdjustToSenderContext[name];
  targetEqualsOrigin ← targetEqualsOrigin AND
    Rope.Equal[simpleName, originName.simpleName, FALSE] AND
    Rope.Equal[registry, originName.registry, FALSE] AND
    Rope.Equal[arpaHost, originName.arpaHost, FALSE];
  IF ~AddedToDuplicateList[name, TRUE] THEN ccCount ← ccCount - 1;
  RETURN[FALSE];
  END; -- of ProcessName --
 
IF answerTargetBodyCharIndex = 0 THEN ERROR GVMailParse.ParseError[badFieldName];
getCharIndex ← answerTargetBodyCharIndex;
InitParse[];
GVMailParse.ParseNameList[pH, ProcessName, !
    GVMailParse.ParseError => answerError ← TRUE];
FinParse[];
END; -- of AnalyzeAnswerTarget --

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

ProcessName: PROCEDURE [
  simpleName, registry, arpaHost: ROPE, nameInfo: GVMailParse.NameInfo]
   RETURNS [accept: BOOLEAN] =
  BEGIN
  name: REF NameRecord ← NEW[NameRecord← [simpleName, registry, arpaHost]];
  qual: Qualification ← AdjustToSenderContext[name];
  new: BOOLEAN ← AddedToDuplicateList[name, firstPass];
  IF nameInfo.nesting = none AND ~new THEN RETURN[FALSE];
  [] ← AdjustToReplyerContext[name, qual];
  IF firstPass THEN
   BEGIN
   ccCount ← ccCount + 1;
   IF ~replyerCCed AND Rope.Equal[simpleName, userName, FALSE] AND
   registry.Length[] = 0 AND arpaHost.Length[] = 0 THEN replyerCCed ← TRUE;
   RETURN[FALSE]
   END;
  IF firstOutput THEN
   BEGIN
   firstOutput ← FALSE;
   IF namesOutput THEN rp← Rope.Concat[rp, ", "];
   END;
  RETURN[namesOutput ← TRUE]
  END; -- of ProcessName --

  AccumulateChars: PROC[ch: CHAR] =
  { IF ch#'\n THEN rp← Rope.Concat[rp, Rope.FromChar[ch]]};

GVMailParse.ParseNameList[pH, ProcessName, AccumulateChars, TRUE];
  IF rp.Length[]#0 THEN answer← Rope.Concat[answer, Rope.Flatten[rp]];
END; -- of FillNameField --

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

-- main body of AnswerCommand

answerError ← FALSE;
-- answer: ROPE;

BEGIN

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

-- make Subject field
answer← "Subject: Re: ";
IF subjectIndex # nullIndex THEN {
getCharIndex ← subjectIndex; InitParse[]; rp← FillField[]; FinParse[]};
reStart ← 0;
 rLen← rp.Length[];
WHILE (rLen > reStart + 2) AND (Rope.Lower[rp.Fetch[reStart]] = 'r) AND
(Rope.Lower[rp.Fetch[reStart+1]] = 'e) AND (rp.Fetch[reStart+2] = ':)
  DO reStart← reStart + 3;
WHILE rLen > reStart AND rp.Fetch[reStart] = ' DO reStart← reStart + 1; ENDLOOP;
ENDLOOP;
answer← Rope.Concat[answer, Rope.Substr[rp, reStart, rLen-reStart]];

-- make In-reply-to field
answer← Rope.Concat[answer, "\nIn-reply-to: "];
IF (IF answerTarget = reply THEN targetEqualsOrigin
ELSE (ccCount = 0 OR (replyerCCed AND ccCount = 1))) THEN
answer← Rope.Concat[answer, "Your"]
ELSE
BEGIN
answer← Rope.Concat[answer, originName.simpleName];
IF originName.registry.Length # 0 THEN
  answer← Rope.Cat[answer, ".", originName.registry];
answer← Rope.Concat[answer, "'"];
IF originName.registry.Length # 0 OR
   Rope.Lower[originName.simpleName.Fetch[originName.simpleName.Length[]-1]] # 's
   THEN answer← Rope.Concat[answer, "s"];
END;
answer← Rope.Concat[answer, " message of "];
InitParse[];
IF dateIndex # nullIndex THEN
  {getCharIndex ← dateIndex; answer← Rope.Concat[answer, FillField[]]};
IF idIndex # nullIndex THEN
  {getCharIndex ← idIndex; answer← Rope.Cat[answer, ", ", FillField[]]};
FinParse[];

-- fill in target (To:) field of answer form
answer← Rope.Concat[answer, "\nTo: "];
ProcessAnswerTarget[];

-- fill in cc: field
answer← Rope.Concat[answer, IF cForCopies THEN "\nc: " ELSE "\ncc: "];
IF answerTarget = reply THEN answer← Rope.Concat[answer, userName]
  ELSE ProcessFields[SecondPass ! GVMailParse.ParseError => GO TO BadMessage];

-- empty line at end of header
answer← Rope.Concat[answer, "\n"];

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

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

END. -- GVAnswerImpl --

Edit Log.
WSH on November 22, 1982; get rid of dependency on IO