WalnutSendOpsExtrasImpl.mesa
extra procs needed by encryption code
last edited by: Willie-Sue, May 23, 1984 9:35:43 am PDT
DIRECTORY
GVMailParse,
IO,
Menus USING [MenuEntry, targetNotFound, FindEntry, ReplaceMenuEntry],
Rope,
RopeList USING [Append],
TiogaOps USING [ViewerDoc],
ViewerClasses USING [Viewer],
ViewerOps USING [BlinkIcon],
WalnutDisplayerOps,
WalnutDocumentRope,
WalnutSendInternal,
WalnutParse,
WalnutSendOpsExtras;
WalnutSendOpsExtrasImpl:
CEDAR
PROGRAM
IMPORTS
GVMailParse, IO, Menus, Rope, RopeList, TiogaOps, ViewerOps,
WalnutDisplayerOps, WalnutDocumentRope, WalnutSendInternal, WalnutParse
EXPORTS WalnutSendOpsExtras =
BEGIN OPEN WalnutSendInternal;
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
GetFieldBody:
PUBLIC PROC[text, fieldName:
ROPE]
RETURNS[fieldBody:
ROPE] =
expects text to be the text of a message; parses the header fields looking for a field named fieldName and returns the value of the fieldBody, or NIL if no such fieldName is found
BEGIN OPEN GVMailParse;
mPos: INT← 0;
lastCharPos: INT← text.Length[];
pH: GVMailParse.ParseHandle← GVMailParse.InitializeParse[];
NextChar: PROC[] RETURNS [ch: CHAR] =
{
IF mPos > lastCharPos
THEN ch← endOfInput
ELSE ch← text.Fetch[mPos];
mPos← mPos + 1;
};
BEGIN
field: ROPE← NIL;
DO
found, fieldNotRecognized: BOOL← TRUE;
[field, found]←
GVMailParse.GetFieldName[pH, NextChar ! ParseError => GOTO parseErrorExit];
IF ~found THEN EXIT;
IF Rope.Equal[fieldName, field,
FALSE]
THEN
-- ignore case
{ fieldBody← GVMailParse.GetFieldBody[pH, NextChar];
EXIT}
ELSE []← GVMailParse.GetFieldBody[pH, NextChar, TRUE];
ENDLOOP;
GVMailParse.FinalizeParse[pH];
EXITS
parseErrorExit => { GVMailParse.FinalizeParse[pH]; RETURN[NIL]};
END;
END;
GetRecipients:
PUBLIC PROC[sender: Viewer]
RETURNS[rList:
LIST
OF
ROPE, parseError:
BOOL] =
expects sender to contain a message to be sent; will parse the headers and return a list of all the recipients of the message; if an error occurs while parsing the viewer, parseError=TRUE is returned, and the viewer will have the offending field underlined.
BEGIN
text: ROPE;
status: SendParseStatus;
sPos, mPos: INT;
TRUSTED
{text← WalnutDocumentRope.Create[LOOPHOLE [TiogaOps.ViewerDoc[sender]]]};
[status, sPos, mPos, rList]← Parse[text];
IF (status # ok) AND (status # includesPublicDL) THEN
BEGIN
SELECT status
FROM
fieldNotAllowed =>
IF sPos # mPos THEN
{ ShowErrorFeedback[sender, sPos, mPos];
SenderReport[Rope.Substr[text, MAX[0, sPos-1], mPos-sPos]];
SenderReport[" field is not allowed\n"]}
ELSE SenderReport[IO.PutFR[" field at pos %g is not allowed\n", IO.int[sPos]]];
syntaxError =>
IF sPos # mPos THEN
{ ShowErrorFeedback[sender, sPos, mPos];
SenderReport["\nSyntax error on line beginning with "];
SenderReport[Rope.Substr[text, MAX[0, sPos-1], mPos-sPos]]}
ELSE SenderReport[IO.PutFR["..... Syntax error at position %g ", IO.int[sPos]]];
includesPrivateDL => SenderReport[" Private dl's are not yet implemented\n"];
ENDCASE => ERROR;
ViewerOps.BlinkIcon[sender, IF sender.iconic THEN 0 ELSE 1];
RETURN[NIL, TRUE]
END;
RETURN[rList, FALSE]
END;
RemoveFromSendMenu:
PUBLIC PROC[name:
ROPE] =
removes the named button from the sender menu, if such a button exists; no errors
BEGIN
old: Menus.MenuEntry← Menus.FindEntry[sendMenu, name];
IF old = NIL THEN RETURN;
Menus.ReplaceMenuEntry[sendMenu, old ! Menus.targetNotFound => CONTINUE];
END;
RemoveFromMsgMenu:
PUBLIC PROC[name:
ROPE] =
removes the named button from the sender menu, if such a button exists; no errors
BEGIN
old: Menus.MenuEntry← Menus.FindEntry[WalnutDisplayerOps.msgMenu, name];
IF old = NIL THEN RETURN;
Menus.ReplaceMenuEntry[WalnutDisplayerOps.msgMenu, old !
Menus.targetNotFound => CONTINUE];
END;
Parse:
PROC[text:
ROPE]
RETURNS[status: SendParseStatus, sPos, mPos:
INT, rList:
LIST
OF
ROPE] =
BEGIN
OPEN GVMailParse;
mLF: WalnutParse.MessageInfo;
lastCharPos: INT← text.Length[] - 1;
lastCharIsCR: BOOL← (text.Fetch[lastCharPos] = '\n);
GetNextChar: PROC[] RETURNS [ch: CHAR] =
{
IF mPos <= lastCharPos
THEN ch← text.Fetch[mPos]
ELSE
IF (mPos=lastCharPos+1)
AND ~lastCharIsCR
THEN ch← '\n
ELSE ch← endOfInput;
mPos← mPos + 1;
};
RNameListField:
PROC[index: WalnutParse.MessageFieldIndex] =
BEGIN
fieldBody, fbEnd: LIST OF ROPE← NIL;
AnotherRName:
PROC[r1, r2:
ROPE, isFile, isNested:
BOOL]
RETURNS [
ROPE,
BOOLEAN] =
BEGIN
name: ROPE ← CanonicalName[r1, r2];
countOfRecipients: INT← 0; -- too lazy to figure this out now
IF fbEnd=
NIL
THEN fbEnd← fieldBody←
CONS[name,
NIL]
ELSE fbEnd← fbEnd.rest← CONS[name, NIL];
IF isFile
THEN status← includesPrivateDL
ELSE
IF name.Find["^"] < 0
THEN countOfRecipients← countOfRecipients + 1
ELSE IF status # includesPrivateDL THEN status← includesPublicDL;
RETURN[NIL, FALSE];
END;
ParseNameList[pH, GetNextChar, AnotherRName,
NIL];
SELECT index
FROM
toF, ccF, cF, bccF =>
IF rList =
NIL
THEN rList← fieldBody
ELSE rList← RopeList.Append[rList, fieldBody];
ENDCASE => NULL;
END;
pH: ParseHandle;
field: ROPE← NIL;
fieldNotRecognized: BOOL;
mPos← 0; -- where we are in the fulltext
status← ok; -- start with good status
pH← InitializeParse[];
DO
sPos← mPos;
[field, fieldNotRecognized]← GetFieldName[pH, GetNextChar ! ParseError =>
{ FinalizeParse[pH]; GOTO errorExit}];
IF ~fieldNotRecognized THEN EXIT;
FOR i: WalnutParse.MessageFieldIndex
IN WalnutParse.MessageFieldIndex
DO
{ mLF← WalnutParse.messageParseArray[i];
IF Rope.Equal[WalnutParse.messageParseArray[i].name, field,
FALSE]
THEN
{ fieldNotRecognized←
FALSE;
IF mLF.fType = rNameList
THEN
RNameListField[i ! ParseError => GOTO errorExit]
ELSE []← GetFieldBody[pH, GetNextChar, TRUE];
};
};
ENDLOOP;
IF fieldNotRecognized
THEN
[]← GetFieldBody[pH, GetNextChar, TRUE]; -- skip anything not recognized
ENDLOOP;
FinalizeParse[pH];
EXITS
errorExit => RETURN[syntaxError, sPos, mPos, NIL];
END;
defaultRegistry: ROPE = "pa";
CanonicalName:
PUBLIC
PROC [simpleName, registry:
ROPE]
RETURNS[name:
ROPE] =
BEGIN
name← simpleName;
IF registry.Length[] = 0
THEN name← name.Cat[".", defaultRegistry]
ELSE name← name.Cat[".", registry];
END;
END.