-- 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 --