TP3/shell/TermCfg.mod

IMPLEMENTATION MODULE TermCfg ;

FROM Posix IMPORT open, read, close ;
FROM SYSTEM IMPORT ADR, BYTE ;

CONST
   ESC = 27 ;
   CR  = 13 ;
   LF  = 10 ;
   BS  = 92 ;        (* backslash, as a number: Modula-2 string escaping is
                        not something to rely on for a single character *)
   MaxFile = 4095 ;

PROCEDURE Clear (VAR s : ARRAY OF CHAR) ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE i <= HIGH (s) DO
      s [i] := 0C ;
      INC (i)
   END
END Clear ;

PROCEDURE Copy (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (dst)) AND (i <= HIGH (src)) AND (src [i] # 0C) DO
      dst [i] := src [i] ;
      INC (i)
   END ;
   IF i <= HIGH (dst) THEN
      dst [i] := 0C
   END
END Copy ;

PROCEDURE Up (ch : CHAR) : CHAR ;
BEGIN
   IF (ch >= 'a') AND (ch <= 'z') THEN
      RETURN CHR (ORD (ch) - 32)
   END ;
   RETURN ch
END Up ;

PROCEDURE KeyIs (key : ARRAY OF CHAR ; want : ARRAY OF CHAR) : BOOLEAN ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   LOOP
      IF (i > HIGH (key)) OR (i > HIGH (want)) THEN
         RETURN FALSE
      END ;
      IF Up (key [i]) # Up (want [i]) THEN
         RETURN FALSE
      END ;
      IF want [i] = 0C THEN
         RETURN TRUE
      END ;
      INC (i)
   END
END KeyIs ;

PROCEDURE ParseValue (src : ARRAY OF CHAR ; VAR dst : ARRAY OF CHAR) ;
(* \e, \r, \n, \t, \\, ^X; everything else is a literal character. *)
VAR i, o, c : CARDINAL ; ch : CHAR ;
BEGIN
   i := 0 ; o := 0 ;
   WHILE (i <= HIGH (src)) AND (src [i] # 0C) DO
      ch := src [i] ;
      IF (ORD (ch) = BS) AND (i + 1 <= HIGH (src)) AND (src [i + 1] # 0C) THEN
         INC (i) ;
         ch := src [i] ;
         IF (ch = 'e') OR (ch = 'E') THEN
            c := ESC
         ELSIF ch = 'r' THEN
            c := CR
         ELSIF ch = 'n' THEN
            c := LF
         ELSIF ch = 't' THEN
            c := 9
         ELSIF ORD (ch) = BS THEN
            c := BS
         ELSE
            c := ORD (ch)
         END
      ELSIF (ch = '^') AND (i + 1 <= HIGH (src)) AND (src [i + 1] # 0C) THEN
         INC (i) ;
         c := ORD (Up (src [i])) - 64
      ELSE
         c := ORD (ch)
      END ;
      IF o <= HIGH (dst) THEN
         dst [o] := CHR (c) ;
         INC (o)
      END ;
      INC (i)
   END ;
   IF o <= HIGH (dst) THEN
      dst [o] := 0C
   END
END ParseValue ;

PROCEDURE Apply (VAR c : Cfg ; key, val : ARRAY OF CHAR) ;
BEGIN
   IF KeyIs (key, "NAME") THEN
      Copy (c.name, val)
   ELSIF KeyIs (key, "CLEAR") THEN
      ParseValue (val, c.clear)
   ELSIF KeyIs (key, "HOME") THEN
      ParseValue (val, c.home)
   ELSIF KeyIs (key, "GOTO") OR KeyIs (key, "MOVETO") THEN
      ParseValue (val, c.moveTo)
   ELSIF KeyIs (key, "NORMAL") THEN
      ParseValue (val, c.normal)
   ELSIF KeyIs (key, "MARKED") THEN
      ParseValue (val, c.marked)
   ELSIF KeyIs (key, "BEEP") THEN
      ParseValue (val, c.beep)
   END
   (* an unknown key is ignored on purpose: TINST's files and ours can then
      share a file without one rejecting the other's fields *)
END Apply ;

PROCEDURE Default (VAR c : Cfg) ;
BEGIN
   Copy (c.name, "ANSI") ;
   ParseValue ("\e[2J\e[H", c.clear) ;
   ParseValue ("\e[H", c.home) ;
   ParseValue ("\e[%r;%cH", c.moveTo) ;
   ParseValue ("\e[0m", c.normal) ;
   ParseValue ("\e[1;7m", c.marked) ;
   ParseValue ("^G", c.beep)
END Default ;

PROCEDURE Load (path : ARRAY OF CHAR ; VAR c : Cfg ; VAR ok : BOOLEAN) ;
VAR fd : INTEGER ;
    k : LONGINT ;
    b : BYTE ;
    buf : ARRAY [0..MaxFile] OF CHAR ;
    n, i, ls, le, eq, j : CARDINAL ;
    key : ARRAY [0..31] OF CHAR ;
    val : ARRAY [0..255] OF CHAR ;
    bad : BOOLEAN ;
BEGIN
   Default (c) ;
   ok := FALSE ;
   fd := open (ADR (path), 0, 0) ;
   IF fd < 0 THEN
      RETURN
   END ;
   n := 0 ;
   LOOP
      k := read (fd, ADR (b), 1) ;
      IF k # 1 THEN
         EXIT
      END ;
      IF b = 26 THEN                       (* ^Z ends the text *)
         EXIT
      END ;
      IF n <= HIGH (buf) THEN
         buf [n] := CHR (ORD (b)) ;
         INC (n)
      END
   END ;
   k := close (fd) ;
   bad := FALSE ;
   i := 0 ;
   WHILE i < n DO
      ls := i ;
      WHILE (i < n) AND (buf [i] # CHR (CR)) AND (buf [i] # CHR (LF)) DO
         INC (i)
      END ;
      le := i ;
      WHILE (i < n) AND ((buf [i] = CHR (CR)) OR (buf [i] = CHR (LF))) DO
         INC (i)
      END ;
      (* trim blanks *)
      WHILE (ls < le) AND ((buf [ls] = ' ') OR (buf [ls] = CHR (9))) DO
         INC (ls)
      END ;
      WHILE (le > ls) AND ((buf [le - 1] = ' ') OR (buf [le - 1] = CHR (9))) DO
         DEC (le)
      END ;
      IF (ls < le) AND (buf [ls] # ';') THEN
         eq := ls ;
         WHILE (eq < le) AND (buf [eq] # '=') DO
            INC (eq)
         END ;
         IF eq = le THEN
            bad := TRUE                       (* a line with no '=' *)
         ELSE
            j := 0 ;
            WHILE (ls < eq) AND (j <= HIGH (key)) DO
               key [j] := buf [ls] ;
               INC (j) ;
               INC (ls)
            END ;
            key [j] := 0C ;
            INC (eq) ;                        (* skip '=' *)
            j := 0 ;
            WHILE (eq < le) AND (j <= HIGH (val)) DO
               val [j] := buf [eq] ;
               INC (j) ;
               INC (eq)
            END ;
            val [j] := 0C ;
            Apply (c, key, val)
         END
      END
   END ;
   ok := NOT bad
END Load ;

END TermCfg.