cmvbt/src/IPTypeinVBT.m3


MODULE IPTypeinVBT;
03/13/2005: Replaced buggy IsComplete, Get, and Key procedures. --R.Coleburn

IMPORT TypeinVBT, KeyFilter, TextPort, VBTClass, VBT;
IMPORT IP, Scan, TextRd, Text, Fmt, Lex, Rd, Thread, FloatMode;

REVEAL
  T = TypeinVBT.T BRANDED "IPTypeinVBT.T" OBJECT OVERRIDES
        key := Key;
      END;
--- this version of IsComplete does not work properly. The ASSERT fires and causes a crash. --RCC
      --- PROCEDURE IsComplete(ip: TEXT): BOOLEAN = 
      ---   TYPE   
      ---     Ch = {Digit, Dot};
      ---   CONST
      ---     mustfind = ARRAY OF Ch {Ch.Digit, Ch.Dot, Ch.Digit, Ch.Dot, Ch.Digit, Ch.Dot, Ch.Digit };
      ---   VAR
      ---     where := FIRST(mustfind);
      ---     a := ARRAY [1..15] OF CHAR { VAL(0,CHAR), ..};
      ---   BEGIN
      ---     Text.SetChars (a, ip); 
      ---     FOR i := FIRST(a) TO LAST(a) DO
      ---       CASE a[i] OF
      ---       | '0'..'9' => 
      ---         IF mustfind[where] = Ch.Dot THEN
      ---           INC(where);
      ---         END;
      ---         IF mustfind[where] # Ch.Digit THEN
      ---           RETURN FALSE;
      ---         END;
      ---       | '.' => 
      ---         <* ASSERT mustfind[where] # Ch.Dot *>
      ---         INC(where);
      ---       ELSE
      ---         EXIT;
      ---       END;
      ---     END;
      ---     RETURN where = LAST(mustfind);
      ---  END IsComplete;
      --- 


PROCEDURE IsComplete(ip: TEXT): BOOLEAN =
  TYPE
    Ch = {Digit, Dot};
  CONST
    mustfind = ARRAY OF Ch {Ch.Digit, Ch.Dot, Ch.Digit, Ch.Dot, Ch.Digit, Ch.Dot, Ch.Digit };
  VAR
    where := FIRST(mustfind);
    a := ARRAY [1..15] OF CHAR { VAL(0,CHAR), ..};
    sawDigit: BOOLEAN := FALSE;
  BEGIN
    Text.SetChars (a, ip);
    FOR i := FIRST(a) TO LAST(a) DO
      CASE a[i] OF
      | '0'..'9' =>
            IF mustfind[where] # Ch.Digit
            THEN
               RETURN FALSE;
            ELSE
               sawDigit := TRUE;
            END; (* if *)
       | '.' =>
            IF sawDigit
            THEN
          INC(where);
            END; (* if *)
            IF mustfind[where] # Ch.Dot
            THEN
          RETURN FALSE;
            ELSE
        INC(where);
               sawDigit := FALSE;
            END; (* if *)
      ELSE
        EXIT;
      END; (* case *)
      END;
    RETURN (where = LAST(mustfind)) AND sawDigit;
 END IsComplete;
--- this version of Key does not work properly.
      --- It does not handle insertion of chars and it does not always add dots when typing.
      --- Replaced by new version. --RCC
      --- 
      --- PROCEDURE Key (t: T; READONLY cd: VBT.KeyRec) =
      ---   <* FATAL FloatMode.Trap, Lex.Error *>
      ---   BEGIN
      ---     IF cd.wentDown AND cd.whatChanged # VBT.NoKey AND
      ---         NOT KeyFilter.IsModifier (cd.whatChanged) THEN
      ---           WITH txt = TextPort.GetText(t), 
      ---                len = Text.Length (txt),
      ---                lastthree = Text.Sub (txt, MAX(len-3,0), 3), 
      ---                dot_in_lastthree = Text.FindChar (lastthree, '.') # -1 DO
      ---             CASE cd.whatChanged OF 
      ---             | ORD('0')..ORD('9') =>
      ---                IF IsComplete(txt) THEN
      ---                  IF NOT dot_in_lastthree THEN RETURN END;
      ---                ELSIF len >= 3 AND NOT dot_in_lastthree THEN
      ---                  VAR fake := cd; BEGIN
      ---                    fake.whatChanged := ORD('.');
      ---                    VBTClass.Key (t, fake);
      ---                    TypeinVBT.T.key (t, cd);
      ---                    RETURN;
      ---                  END;
      ---                END;
      ---                WITH lastnum = 
      ---                  Text.Sub (lastthree, MAX(0, Text.FindCharR(lastthree, '.')+1), 3) DO
      ---                  IF NOT Text.Empty (lastnum) THEN
      ---                    CASE Scan.Int(lastnum) OF 
      ---                    | 0..24 => (* continue 

|---                    | 25    => IF cd.whatChanged > ORD('5') THEN RETURN END;
|---                    ELSE     RETURN
|---                    END;
|---                  END;
|---                END;
|---                TypeinVBT.T.key (t, cd);
|---             | ORD('.') =>
|---               IF IsComplete (txt) THEN
|---                 (* ignore incoming keys *)
|---               ELSIF len # 0 AND Text.GetChar(txt, len-1) # '.' THEN
|---                 TypeinVBT.T.key (t, cd);
|---               END;
|---             | ORD(FIRST(CHAR))..ORD('.')-1,
|---               ORD('.')+1..ORD('0')-1,
|---               ORD('9')+1..ORD(LAST(CHAR)) =>
|---               (* ignore any printable characters *)
|---             ELSE (* other keys, like Return, tab, etc... *)
|---               TypeinVBT.T.key (t, cd);
|---             END
|---         END;
|---     END
|---   END Key;
|---*)

PROCEDURE Key (t: T; READONLY cd: VBT.KeyRec) =
  <* FATAL FloatMode.Trap, Lex.Error *>
  BEGIN
      IF cd.wentDown AND
         cd.whatChanged # VBT.NoKey AND
         NOT KeyFilter.IsModifier (cd.whatChanged)
      THEN
          WITH txt = TextPort.GetText(t),
               len = Text.Length (txt),
               lastthree = Text.Sub (txt, MAX(len-3,0), 3),
            dot_in_lastthree = Text.FindChar (lastthree, '.') # -1,
            complete = IsComplete(txt),
            pos = TextPort.Index(t)
         DO
            CASE cd.whatChanged OF
            | ORD('0')..ORD('9') =>
                  IF pos = len
                  THEN (* adding at end of text *)
                     IF complete
                     THEN
                        IF NOT dot_in_lastthree
                        THEN
                           RETURN
                        END; (* if *)
                     ELSIF len >= 3 AND NOT dot_in_lastthree
                     THEN
                        VAR fake := cd;
                        BEGIN (* block *)
                   fake.whatChanged := ORD('.');
                   VBTClass.Key (t, fake);
                   TypeinVBT.T.key (t, cd);
                   RETURN;
                        END; (* block *)
                     END; (* if *)
                     WITH lastnum = Text.Sub (lastthree, MAX(0, Text.FindCharR(lastthree, '.')+1), 3)
                     DO
                        IF NOT Text.Empty (lastnum)
                        THEN
                   CASE Scan.Int(lastnum) OF
                   | 0..24 => (* continue *)
                   | 25    => IF cd.whatChanged > ORD('5') THEN RETURN END;
                           ELSE
                              IF NOT complete
                              THEN
                                 VAR fake := cd;
                                 BEGIN (* block *)
                                    fake.whatChanged := ORD('.');
                                    VBTClass.Key (t, fake);
                                 END; (* block *)
                              END; (* if *)
                           END; (* case *)
                        END; (* if *)
                     END; (* with *)
               TypeinVBT.T.key (t, cd);
                  ELSE (* inserting at beginning or middle *)
                     TypeinVBT.T.key(t, cd);
                  END; (* if *)
            | ORD('.') =>
                  IF complete
                  THEN
                (* ignore incoming keys *)
                  ELSIF (pos = len) OR (* (appending dot to incomplete seq) OR *)
                        ((pos > 0) AND (Text.GetChar(txt, pos-1) # '.') AND (* (inserting dot not at beginning) AND (not preceded by a dot) AND *)
                         (Text.GetChar(txt, pos) # '.')) (* (inserting dot not followed by a dot) *)
                  THEN
                TypeinVBT.T.key (t, cd);
                  ELSE
                     (* ignore this dot *)
                  END; (* if *)
            | ORD(FIRST(CHAR))..ORD('.')-1,
              ORD('.')+1..ORD('0')-1,
              ORD('9')+1..ORD(LAST(CHAR)) =>
              (* ignore any printable characters *)
            ELSE (* other keys, like Return, tab, etc... *)
              TypeinVBT.T.key (t, cd);
            END; (* case *)
         END; (* with *)
      END; (* if *)
  END Key;
--- this version of Get crashes if octets out of range; replaced by new version. --RCC
      --- PROCEDURE Get(v: T): IP.Address RAISES {InvalidAddress} = 
      ---   VAR
      ---     ip: IP.Address;
      ---     rd := TextRd.New(TextPort.GetText(v));
      ---   BEGIN
      ---     TRY
      ---       FOR i := FIRST(ip.a) TO LAST(ip.a) DO
      ---         ip.a[i] := Lex.Int (rd);
      ---         IF ip.a[i] < 0 OR ip.a[i] > 255 THEN RAISE InvalidAddress END;
      ---         IF i # LAST(ip.a) THEN Lex.Match (rd, ".") END;
      ---       END;
      ---     EXCEPT
      ---     | Lex.Error, Rd.Failure, Thread.Alerted, FloatMode.Trap => 
      ---         RAISE InvalidAddress;
      ---     END;
      ---     RETURN ip;
      ---   END Get;
      --- 


PROCEDURE Get(v: T): IP.Address RAISES {InvalidAddress} =
  VAR
    ip: IP.Address;
    rd := TextRd.New(TextPort.GetText(v));
  BEGIN
    TRY
      FOR i := FIRST(ip.a) TO LAST(ip.a) DO
        WITH octet = Lex.Int (rd)
        DO
          IF (octet < 0) OR (octet > 255)
          THEN RAISE InvalidAddress;
          ELSE ip.a[i] := octet;
          END;
        END; (* with *)
        IF i # LAST(ip.a) THEN Lex.Match (rd, ".") END;
      END;
    EXCEPT
    | Lex.Error, Rd.Failure, Thread.Alerted, FloatMode.Trap =>
        RAISE InvalidAddress;
    END;
    RETURN ip;
  END Get;

PROCEDURE Put (v: T; addr: IP.Address) RAISES {InvalidAddress} =
  PROCEDURE Conv (i: INTEGER): TEXT RAISES {InvalidAddress} =
    BEGIN
      IF i >= 0 AND i <= 255 THEN
        RETURN Fmt.Int(i);
      END;
      RAISE InvalidAddress;
    END Conv;
  VAR
    txt := Conv(addr.a[0]);
  BEGIN
    FOR i := 1 TO 3 DO
      txt := txt & "." & Conv(addr.a[i]);
    END;
    TextPort.SetText (v, txt);
  END Put;

BEGIN
END IPTypeinVBT.