-- MessageParseImpl.mesa
-- Edited by Brotz, March 30, 1982  2:55 PM
-- Edited by Barth, October 9, 1981  3:05 PM

DIRECTORY
  Ascii,
  dsD: FROM "DisplayDefs",
  Inline,
  MessageParse,
  ovD: FROM "OverviewDefs",
  Storage,
  String,
  vmD: FROM "VirtualMgrDefs";

MessageParseImpl: PROGRAM
  IMPORTS dsD, Inline, Storage, String, vmD
  EXPORTS MessageParse = 

BEGIN
OPEN MessageParse;


ParseMessage: PUBLIC PROCEDURE [vm: vmD.VirtualMessagePtr, fields: FieldRecDescriptor] =
-- The message in vm is scanned for field names matching the set of names given in fields.
--   The number of times each field name is encountered in vm is set in the found field
--   corresponding to that field name.  For any field whose found number is greater than
--   or equal to 1, the bodyStart field is set to the index of the first character following the
--   field name's colon, and the bodyEnd field is set to the CharIndex of the first carriage
--   return (or end of message) that terminates that field body.  If found = 0, then bodyStart
--   and bodyEnd are 0.  vm is searched for fields from [0 .. MessageLength[vm]).
BEGIN
state: {newField, foundField, skipField} _ newField;
fieldPtr: FieldRecPtr;
end: vmD.CharIndex _ vmD.GetMessageSize[vm];
get: POINTER TO vmD.CharCache _ @vm.get;
s: STRING _ [80];
FOR fieldIndex: CARDINAL IN [0 .. LENGTH[fields]) DO
  fields[fieldIndex].found _ fields[fieldIndex].bodyStart _ fields[fieldIndex].bodyEnd _ 0
  ENDLOOP;
FOR i: vmD.CharIndex _ 0, i + 1 UNTIL i = end DO
  char: CHARACTER _ Inline.BITAND[ovD.CharMask, IF i IN [get.first .. get.free)
     THEN vm.buffer.chars[i + get.floor - get.first] ELSE vmD.GetMessageChar[vm, i]];
  IF char = Ascii.CR THEN
    BEGIN
    IF i + 1 = end
      OR ((char _ vmD.GetMessageChar[vm, i + 1]) # Ascii.SP
        AND char # Ascii.TAB AND char # Ascii.ControlY)
      THEN BEGIN
      IF state = foundField OR state = skipField THEN 
        BEGIN
        IF state = foundField THEN fieldPtr.bodyEnd _ i;
        state _ newField;
        END;
      s.length _ 0;
      END;
    END
  ELSE IF state = newField THEN
    SELECT char FROM
      ': =>
        BEGIN
        FOR fieldIndex: CARDINAL IN [0 .. LENGTH[fields]) DO
          IF String.EquivalentString[fields[fieldIndex].name, s] THEN
            BEGIN
            fieldPtr _ @fields[fieldIndex];
            fieldPtr.found _ fieldPtr.found + 1;
            IF fieldPtr.found = 1 THEN {state _ foundField; fieldPtr.bodyStart _ i + 1}
            ELSE state _ skipField;
            EXIT;
            END;
          REPEAT
          FINISHED => state _ skipField;
          ENDLOOP;
        END;
      Ascii.SP, Ascii.TAB, Ascii.ControlY => NULL;
      ENDCASE =>
        IF s.length < s.maxlength THEN {s[s.length] _ char; s.length _ s.length + 1}
        ELSE state _ skipField;
  ENDLOOP;
  IF state = foundField THEN fieldPtr.bodyEnd _ end;
END;  -- of ParseMessage --


ParseFault: PUBLIC SIGNAL [error: ParseError] = CODE;


MakeFieldList: PUBLIC PROC [vm: vmD.VirtualMessagePtr] RETURNS [fieldList: FieldList] =
-- Creates a complete list of fields contained in vm.  The fields in the list are sorted by
--   position in vm.
BEGIN
state: {newField, foundField, skipField} _ newField;
currentFL: FieldList;
fieldListPtr: FieldListPtr _ @fieldList;
start: vmD.CharIndex _ 0;
end: vmD.CharIndex _ vmD.GetMessageSize[vm];
get: POINTER TO vmD.CharCache _ @vm.get;
s: STRING _ [40];
fieldListPtr^ _ NIL;
FOR i: vmD.CharIndex _ 0, i + 1 UNTIL i = end DO
  char: CHARACTER _ Inline.BITAND[ovD.CharMask, IF i IN [get.first .. get.free)
     THEN vm.buffer.chars[i + get.floor - get.first] ELSE vmD.GetMessageChar[vm, i]];
  IF char = Ascii.CR THEN
    BEGIN
    IF i + 1 = end
      OR ((char _ vmD.GetMessageChar[vm, i + 1]) # Ascii.SP
        AND char # Ascii.TAB AND char # Ascii.ControlY) THEN
      BEGIN
      IF state = foundField THEN currentFL.valueEnd _ i;
      state _ newField;
      start _ i + 1;
      s.length _ 0;
      END;
    END
  ELSE IF state = newField THEN
    SELECT char FROM
      ': =>
        BEGIN
        fieldListPtr^ _ currentFL _ Storage.Node[SIZE[FieldListRec]];
        fieldListPtr _ @currentFL.next;
        currentFL^ _ FieldListRec[Storage.CopyString[s], start, i + 1, 0, NIL];
        state _ foundField;
        END;
      Ascii.SP, Ascii.TAB, Ascii.ControlY => NULL;
      ENDCASE =>
        IF s.length < s.maxlength THEN {s[s.length] _ char; s.length _ s.length + 1}
        ELSE state _ skipField;
  ENDLOOP;
IF state = foundField THEN currentFL.valueEnd _ end;
END;  -- of MakeFieldList --


FreeFieldList: PUBLIC PROCEDURE [fieldList: FieldList] =
-- Frees all storage associated with fieldList.
BEGIN
nextFieldList: FieldList;
FOR fieldList _ fieldList, nextFieldList UNTIL fieldList = NIL DO
  nextFieldList _ fieldList.next;
  Storage.FreeString[fieldList.field];
  Storage.Free[fieldList];
  ENDLOOP;
END;  -- of FreeFieldList --


LocateField: PUBLIC PROCEDURE [fieldList: FieldList, name: STRING]
  RETURNS [field: FieldList, count: CARDINAL] =
-- Searches fieldList for a FieldListRec matching name.  Returns a pointer to the matched
--   FieldListRec and a count of how many matches actually occur in the list.
BEGIN
field _ NIL;
count _ 0;
FOR fieldList _ fieldList, fieldList.next UNTIL fieldList = NIL DO
  IF String.EquivalentString[fieldList.field, name] THEN
    BEGIN
    IF count = 0 THEN field _ fieldList;
    count _ count + 1;
    END;
  ENDLOOP;
END;  -- of LocateField --


UpdateFieldList: PUBLIC PROCEDURE [fieldList: FieldList, delta: INTEGER] =
-- Increments the CharIndex's in the Field List starting at fieldList by delta.  This procedure
--   should be used whenever editing causes modifications in field positions.
BEGIN
FOR fieldList _ fieldList, fieldList.next UNTIL fieldList = NIL DO
  fieldList.start _ fieldList.start + delta;
  fieldList.valueStart _ fieldList.valueStart + delta;
  fieldList.valueEnd _ fieldList.valueEnd + delta;
  ENDLOOP;
END;  -- of UpdateFieldList --


ReplaceOrAppendField: PUBLIC PROCEDURE
  [cm: vmD.ComposedMessagePtr, fieldListPtr: MessageParse.FieldListPtr,
  field, value: STRING, insertAtBeginning: BOOLEAN _ FALSE] =
BEGIN
count: CARDINAL;
fieldList: FieldList;
cmSize: vmD.CharIndex _ vmD.GetMessageSize[cm];
IF value = NIL THEN RETURN;
[fieldList, count] _ LocateField[fieldListPtr^, field];
IF count = 0 THEN
  BEGIN
  needsCR: BOOLEAN _ ~insertAtBeginning
    AND (cmSize > 0 AND vmD.GetMessageChar[cm, cmSize - 1] # Ascii.CR);
  vmD.StartMessageInsertion[cm, IF insertAtBeginning THEN 0 ELSE cmSize];
  IF needsCR THEN {vmD.InsertMessageChar[cm, Ascii.CR]; cmSize _ cmSize + 1};
  vmD.InsertStringInMessage[cm, field];
  vmD.InsertStringInMessage[cm, ": "L];
  vmD.InsertStringInMessage[cm, value];
  vmD.InsertMessageChar[cm, Ascii.CR];
  vmD.StopMessageInsertion[cm];
  IF insertAtBeginning THEN
    BEGIN
    fieldList _ Storage.Node[SIZE[FieldListRec]];
    fieldList^ _ FieldListRec[Storage.CopyString[field], 0, field.length + 1,
      field.length + value.length + 2, fieldListPtr^];
    fieldListPtr^ _ fieldList;
    UpdateFieldList[fieldList.next, field.length + value.length + 3];
    END
  ELSE BEGIN
    FOR fieldListPtr _ fieldListPtr, @fieldListPtr^.next UNTIL fieldListPtr^ = NIL DO
      ENDLOOP;
    fieldListPtr^ _ fieldList _ Storage.Node[SIZE[FieldListRec]];
    fieldList^ _ FieldListRec[Storage.CopyString[field], cmSize, cmSize + field.length + 1,
      vmD.GetMessageSize[cm] - 1, NIL];
    END;
  END
ELSE BEGIN
  vmD.DeleteRangeInMessage[[fieldList.valueStart, fieldList.valueEnd, cm]];
  fieldList.valueEnd _ fieldList.valueStart;
  vmD.StartMessageInsertion[cm, fieldList.valueStart];
  IF value.length > 0 THEN
    SELECT value[0] FROM
      Ascii.SP, Ascii.TAB, Ascii.ControlY => NULL;
      ENDCASE =>
        {vmD.InsertMessageChar[cm, Ascii.SP]; fieldList.valueEnd _ fieldList.valueEnd + 1};
  vmD.InsertStringInMessage[cm, value];
  vmD.StopMessageInsertion[cm];
  UpdateFieldList[fieldList.next, vmD.GetMessageSize[cm] - cmSize];
  fieldList.valueEnd _ fieldList.valueEnd + value.length;
  END;
END;  -- of ReplaceOrAppendField --


DeleteField: PUBLIC PROCEDURE
  [cm: vmD.ComposedMessagePtr, fieldListPtr: MessageParse.FieldListPtr, name: STRING] =
BEGIN
FOR fieldListPtr _ fieldListPtr, @fieldListPtr^.next UNTIL fieldListPtr^ = NIL DO
  IF String.EquivalentString[fieldListPtr^.field, name] THEN
    BEGIN
    range: vmD.MessageRange;
    fieldList: FieldList _ fieldListPtr^;
    range _ [fieldList.start, MIN[fieldList.valueEnd + 1, vmD.GetMessageSize[cm]], cm];
    vmD.DeleteRangeInMessage[range];
    UpdateFieldList[fieldList.next, range.start - range.end];
    fieldListPtr^ _ fieldList.next;
    Storage.FreeString[fieldList.field];
    Storage.Free[fieldList];
    RETURN;
    END;
  ENDLOOP;
END;  -- of DeleteField --


GetNumberFromField: PUBLIC PROCEDURE
    [vm: vmD.VirtualMessagePtr, fieldList: FieldList, s: STRING]
  RETURNS [value: CARDINAL] =
BEGIN
temp: STRING _ [10];
count: CARDINAL;
[fieldList, count] _ LocateField[fieldList, s];
IF count = 0 THEN RETURN[0];
[] _ GetNextNumber[vm, fieldList.valueStart, fieldList.valueEnd, temp];
value _ String.StringToDecimal[temp ! String.InvalidNumber => {value _ 0; CONTINUE}];
END;  -- of GetNumberFromField --


GetStringFromField: PUBLIC PROCEDURE
  [vm: vmD.VirtualMessagePtr, fieldList: FieldList, field, value: STRING] =
-- Returns in "value" the first word in the value portion of the "field" of "vm".
BEGIN
count: CARDINAL;
[fieldList, count] _ LocateField[fieldList, field];
value.length _ 0;
IF count > 0 THEN [] _ GetNextWord[vm, fieldList.valueStart, fieldList.valueEnd, value];
END;  -- of GetStringFromField --


GetWholeField: PUBLIC PROCEDURE
  [vm: vmD.VirtualMessagePtr, fieldList: FieldList, name, value: STRING] =
BEGIN
count: CARDINAL;
[fieldList, count] _ LocateField[fieldList, name];
IF count = 0 THEN {value.length _ 0; RETURN};
value.length _ MIN [value.maxlength, fieldList.valueEnd - fieldList.valueStart];
FOR i: CARDINAL IN [0 .. value.length) DO
  value[i] _ vmD.GetMessageChar[vm, fieldList.valueStart + i];
  ENDLOOP;
END;  -- of GetWholeField --


GetNextWord: PUBLIC PROCEDURE [vm: vmD.VirtualMessagePtr, start, end: vmD.CharIndex,
    s: STRING, includePlusAndMinus: BOOLEAN _ TRUE]
  RETURNS [newStart: vmD.CharIndex] =
-- Within vm[[start .. end)], the next word (run of non-whitespace characters) in vm is
--   copied into s.  Leading whitespace characters are ignored.   newStart is the CharIndex
--   suitable for passing into GetNextWord or GetNextNumber to get a subsequent word or
--   number.
-- IF includePlusAndMinus is TRUE, then + and - are treated as if they were alphanumeric.
-- May raise ParseFault[stringTooSmall] if the word to be copied into s is larger than
--   s.maxlength.
BEGIN
get: POINTER TO vmD.CharCache _ @vm.get;
s.length _ 0;
FOR i: vmD.CharIndex _ start, i + 1 UNTIL i = end DO
  char: CHARACTER _ Inline.BITAND[ovD.CharMask, IF i IN [get.first .. get.free)
    THEN vm.buffer.chars[i + get.floor - get.first]
    ELSE vmD.GetMessageChar[vm, i]];
  charType: dsD.CharProperty _ dsD.GetCharBreakProp[char];
  BEGIN
  ENABLE String.StringBoundsFault => GO TO Bummer;
  SELECT charType FROM
    alphaNumeric => String.AppendChar[s, char];
    white => IF s.length # 0 THEN RETURN[i + 1];
    punctuation =>
      SELECT TRUE FROM
        (includePlusAndMinus AND (char = '+ OR char = '-)) => String.AppendChar[s, char];
        s.length # 0 => RETURN[i];
        ENDCASE => {String.AppendChar[s, char]; RETURN[i + 1]};
    ENDCASE => ERROR;
  EXITS
  Bummer => SIGNAL ParseFault[stringTooSmall];
  END;
  ENDLOOP;
RETURN[end];
END;  -- of GetNextWord --


GetNextNumber: PUBLIC PROCEDURE [vm: vmD.VirtualMessagePtr, start, end: vmD.CharIndex,
  s: STRING] RETURNS [newStart: vmD.CharIndex] =
-- Within vm[[start .. end)], the next number (defined as [+/-]D*.D*[E[+/-]D*], where
--   [x] indicates an optional part, +/- indicates either a plus or minus sign, D* is 0 or
--   more digits, E is the letter E) in vm is copied into s.  Examples: 10, -23, +.34, 2.1E-12,
--   1E3, 0.2.  Leading whitespace characters are ignored.   newStart is the CharIndex
--   suitable for passing into GetNextWord or GetNextNumber to get a subsequent word
--   or number.
-- May raise ParseFault[stringTooSmall] if the number to be copied into s is larger than
--   s.maxlength.  May raise ParseFault[illegalNumber] if no legal number occurs next in
--   vm.
BEGIN
state: {start, inWholePart, inFraction, inExpSign, inExp} _ start;
get: POINTER TO vmD.CharCache _ @vm.get;
i: vmD.CharIndex;
s.length _ 0;
FOR i _ start, i + 1 UNTIL i = end DO
  char: CHARACTER _ Inline.BITAND[ovD.CharMask, IF i IN [get.first .. get.free)
              THEN vm.buffer.chars[i + get.floor - get.first]
              ELSE vmD.GetMessageChar[vm, i]];
  BEGIN
  ENABLE String.StringBoundsFault => GO TO Bummer;
  SELECT char FROM
    IN ['0 .. '9] => BEGIN
      String.AppendChar[s, char];
      IF state = start THEN state _ inWholePart
      ELSE IF state = inExpSign THEN state _ inExp;
      END;
    Ascii.SP, Ascii.TAB, Ascii.CR => IF s.length # 0 THEN EXIT;
    '-, '+ =>
      SELECT state FROM
        start => {String.AppendChar[s, char]; state _ inWholePart};
        inWholePart, inFraction, inExp => EXIT;
        inExpSign => {String.AppendChar[s, char]; state _ inExp};
        ENDCASE => ERROR;
    '. =>
      SELECT state FROM
        start, inWholePart => {String.AppendChar[s, char]; state _ inFraction};
        inFraction, inExp => EXIT;
        inExpSign => {s.length _ s.length - 1; i _ i - 1; EXIT};
        ENDCASE => ERROR;
    'E, 'e =>
      SELECT state FROM
        inWholePart, inFraction => {String.AppendChar[s, char]; state _ inExpSign};
        start, inExp => EXIT;
        inExpSign => {s.length _ s.length - 1; i _ i - 1; EXIT};
        ENDCASE => ERROR;
    ENDCASE => EXIT;
  EXITS
  Bummer => SIGNAL ParseFault[stringTooSmall];
  END;
  ENDLOOP;
IF s.length = 0 THEN ERROR ParseFault[illegalNumber];
RETURN[i];
END;  -- of GetNextNumber --


END.  -- of MessageParseImpl --

(635)\f1