TP3/shell/Keys.mod

IMPLEMENTATION MODULE Keys ;

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

CONST
   MaxFile = 4095 ;
   CR = 13 ;
   LF = 10 ;

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

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

PROCEDURE One (val : ARRAY OF CHAR ; VAR ch : CHAR ; VAR good : BOOLEAN) ;
(* exactly one decoded byte *)
VAR tmp : ARRAY [0..63] OF CHAR ;
BEGIN
   ParseValue (val, tmp) ;
   IF (tmp [0] # 0C) AND (tmp [1] = 0C) THEN
      ch := tmp [0] ;
      good := TRUE
   ELSE
      good := FALSE
   END
END One ;

PROCEDURE Apply (VAR m : Map ; name, val : ARRAY OF CHAR ; VAR bad : BOOLEAN) ;
VAR good : BOOLEAN ;
BEGIN
   good := TRUE ;
   IF Eq (name, "QUIT") THEN One (val, m.quit, good)
   ELSIF Eq (name, "CANCEL") THEN One (val, m.cancel, good)
   ELSIF Eq (name, "PREFIX") THEN One (val, m.prefix, good)
   ELSIF Eq (name, "LITERAL") THEN One (val, m.literal, good)
   ELSIF Eq (name, "WORDLEFT") THEN One (val, m.wordLeft, good)
   ELSIF Eq (name, "CHARLEFT") THEN One (val, m.charLeft, good)
   ELSIF Eq (name, "CHARRIGHT") THEN One (val, m.charRight, good)
   ELSIF Eq (name, "WORDRIGHT") THEN One (val, m.wordRight, good)
   ELSIF Eq (name, "LINEUP") THEN One (val, m.lineUp, good)
   ELSIF Eq (name, "LINEDOWN") THEN One (val, m.lineDown, good)
   ELSIF Eq (name, "SCROLLUP") THEN One (val, m.scrollUp, good)
   ELSIF Eq (name, "SCROLLDOWN") THEN One (val, m.scrollDown, good)
   ELSIF Eq (name, "PAGEUP") THEN One (val, m.pageUp, good)
   ELSIF Eq (name, "PAGEDOWN") THEN One (val, m.pageDown, good)
   ELSIF Eq (name, "INSERTTOGGLE") THEN One (val, m.insertToggle, good)
   ELSIF Eq (name, "DELETECHAR") THEN One (val, m.deleteChar, good)
   ELSIF Eq (name, "DELETELEFT") THEN One (val, m.deleteLeft, good)
   ELSIF Eq (name, "DELETEWORD") THEN One (val, m.deleteWord, good)
   ELSIF Eq (name, "INSERTBREAK") THEN One (val, m.insertBreak, good)
   ELSIF Eq (name, "DELETELINE") THEN One (val, m.deleteLine, good)
   ELSIF Eq (name, "REPEAT") THEN One (val, m.repeatLast, good)
   ELSIF Eq (name, "AUTOTAB") THEN One (val, m.autoTab, good)
   ELSIF Eq (name, "NEWLINE") THEN One (val, m.newLine, good)
   END ;
   IF NOT good THEN
      bad := TRUE
   END
END Apply ;

PROCEDURE Default (VAR m : Map) ;
BEGIN
   m.quit         := CHR (17) ;   (* ^Q *)
   m.cancel       := CHR (21) ;   (* ^U *)
   m.prefix       := CHR (11) ;   (* ^K *)
   m.literal      := CHR (16) ;   (* ^P *)
   m.wordLeft     := CHR (1) ;    (* ^A *)
   m.charLeft     := CHR (19) ;   (* ^S *)
   m.charRight    := CHR (4) ;    (* ^D *)
   m.wordRight    := CHR (6) ;    (* ^F *)
   m.lineUp       := CHR (5) ;    (* ^E *)
   m.lineDown     := CHR (24) ;   (* ^X *)
   m.scrollUp     := CHR (23) ;   (* ^W *)
   m.scrollDown   := CHR (26) ;   (* ^Z *)
   m.pageUp       := CHR (18) ;   (* ^R *)
   m.pageDown     := CHR (3) ;    (* ^C *)
   m.insertToggle := CHR (22) ;   (* ^V *)
   m.deleteChar   := CHR (7) ;    (* ^G *)
   m.deleteLeft   := CHR (8) ;    (* ^H *)
   m.deleteWord   := CHR (20) ;   (* ^T *)
   m.insertBreak  := CHR (14) ;   (* ^N *)
   m.deleteLine   := CHR (25) ;   (* ^Y *)
   m.repeatLast   := CHR (12) ;   (* ^L *)
   m.autoTab      := CHR (9) ;    (* ^I *)
   m.newLine      := CHR (13)     (* ^M *)
END Default ;

PROCEDURE Load (path : ARRAY OF CHAR ; VAR m : Map ; VAR ok : BOOLEAN) ;
VAR fd : INTEGER ;
    k : LONGINT ;
    b : BYTE ;
    buf : ARRAY [0..MaxFile] OF CHAR ;
    n, i, ls, le, eq, j : CARDINAL ;
    name : ARRAY [0..31] OF CHAR ;
    val : ARRAY [0..63] OF CHAR ;
    bad : BOOLEAN ;
BEGIN
   Default (m) ;
   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 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 ;
      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
         ELSE
            j := 0 ;
            WHILE (ls < eq) AND (j <= HIGH (name)) DO
               name [j] := buf [ls] ; INC (j) ; INC (ls)
            END ;
            name [j] := 0C ;
            INC (eq) ;
            j := 0 ;
            WHILE (eq < le) AND (j <= HIGH (val)) DO
               val [j] := buf [eq] ; INC (j) ; INC (eq)
            END ;
            val [j] := 0C ;
            Apply (m, name, val, bad)
         END
      END
   END ;
   ok := NOT bad
END Load ;

END Keys.