$Search 'KRMWNDW', 'KRMRPT'$
$ucsd on$

module command;
import  windowlib,
        err_codes,
        krmrpt;
export

const
  text_string_size = 255;
  MAXKEYWORDS = 20;
  required = false;         { arguments for parse, tell if arg is optional }
  optional = true;
  
type
  breakset_type = set of char;
  arg_type = (p_char,  p_integer,  p_text,  p_eol,  p_boolean,
               p_password, p_keyword);
  text_string = string [text_string_size];
  keyword_string_type = string [20];
  keyword_entry = record
                    ks : keyword_string_type;
                    kv : integer;
                  end;  { record }
  
  keyword_table = array[1..MAXKEYWORDS] of keyword_entry;
  keyword_table_ptr = ^keyword_table;

var
  parse_keyword_table : keyword_table_ptr;
  parse_result : integer;  { result of last parse }
  parse_result_str : text_string;
  
{
These are the argument buffers.  There is one buffer for each type of
argument.
}
  arg_char : char;
  arg_integer : integer;          { holds integers }
  arg_keyword : keyword_string_type;  { holds full keyword text of last
                                        parsed keyword }
  arg_text : text_string;         { holds text, keywords, passwords }
  arg_boolean : boolean;


procedure parse_init ( var prompt : string );
procedure parse( arg : arg_type ;  opt : boolean );

$page$
implement

var
eol_parsed : boolean;   { cleared by parse_init, set by parse }

cur_bufpos : integer;        { position of next char to be put in buffer }
init_bufpos : integer;       { position of first char of this token }
parse_buffer : string [80];

  
function read_kbd_char : char;
{
  Reads a char from the keyboard (non-echoing).  If a carriage return is
  typed,  returns a control M (#M).
}  
  var c : char;
  begin
  if eoln(keyboard)
       then begin
            readln(keyboard);
            c := #13;  { carriage return }
            end
       else read(keyboard,c);
  read_kbd_char := c;
  end;  { function read_kbd_char }
       
$page$
{
read_break      Reads from the terminal until one of a specified set of
characters is read.  The break character that terminated the read is
placed in breakchar.
  
Inputs :        buffer          Buffer used to accumulate actual characters
                                typed on keyboard, including prompt and break
                                characters
                init_bufpos     Initial position in buffer in which to store
                                the next character read from the keyboard.
                                Will be updated to point to next char. after
                                current input.
                atom            String in which to return the token read
                                (without break characters)
                breakset        Set of characters which, when typed, signal
                                that the token has been completed and that
                                it should now be parsed
                breakchar       Receives the break character actually
                                read
                echo            If true, characters read will be echoed
                                to the screen; if false, they will not
                                be echoed.
                
Returns :    Result code, one of the following:

    success             The field was successfully read
    back_past_field     The user backed up past the beginning of this field
    abort_line          The user aborted the line by typing CTRL-U
    null_string         The user typed only a break character
}
function read_break( var buffer : string;
                     init_bufpos : integer;
                     var cur_bufpos : integer;
                     var atom : string;
                     breakset : breakset_type;
                     var breakchar : char;
                     echo : boolean ) : integer;
  
  var c : char;
      done : boolean;
      result : integer;
      bufpos : integer;
      
  begin
  result := success;
  done := false;
  bufpos := cur_bufpos;
  {setstrlen(atom,0);}
  
  repeat
    c := read_kbd_char;
    case c of
       #H,#127:   begin           { backspace or delete }
                  if bufpos > init_bufpos
                     then begin  { delete the character }
                       bufpos := bufpos-1;
                       setstrlen( buffer, strlen(buffer)-1);
                       setstrlen( atom, strlen(atom)-1);
                       write_window_char(command_window,#127);
                       end  { delete the character }
                     else begin  { backing up past beginning of field }
                          write(#7);  { beep }
                          result := back_past_field;
                          done := true;
                          end;  { backing up past field }
                  end;            { backspace or delete }
       #U:        begin           { control-U }
                  done := true;
                  result := abort_line;
                  end;            { control-U }
       #R:        begin           { control-R }
                  end;            { control-R }
       
       otherwise  begin           { c is not an editing char }
           if c >= #32 then begin        { if c is printable }
              setstrlen(buffer,strlen(buffer)+1);
              buffer[bufpos] := c;
              bufpos := bufpos + 1;
              if echo 
                 then write_window_char(command_window, c);
              end;  { if c is printable }
            
           if not (c in breakset)
               then if c >= #32
                       then begin       { c is printable }
                         setstrlen(atom,strlen(atom)+1);
                         atom[strlen(atom)] := c;
                         end  { c is printable }
                       else begin  { c is not printable }
                         write(#7);  { beep }
                         end   { c is not printable }
               else begin  { c is a break char }
                 breakchar := c;
                 if strlen(atom) <> 0
                    then result := success
                    else result := null_string;
                 done := true;
                 end;  { c is a break char }
            end;  { c is not an editing char }
    end;  { case }
  until done;
  read_break := result;
  cur_bufpos := bufpos;
  end;  { procedure read_break }
  
  
$page$
function stoi( var s : string ;  var i : integer ) : integer;
{
  
Converts string to integer.
  
Inputs :        s       string containing decimal digits to convert
                i       integer to receive the converted value if successful
                
Returns  :      Status code, one of the following:

        success                 Integer converted successfully
        non_digit               Non-digit character encountered
        overflow                Integer overflow
        null_string             Null string given as argument
}
  var
    e, j, digit : integer;    
    c : char;
    result : integer;
  begin
    result := success;
    e := 1;
    i := 0;
    j := strlen(s);
    if j = 0
       then result := null_string;
    while (j <> 0) and (result = success) do begin
      c := s[j];
      digit := ord(c) - ord('0');
      if (digit < 0) or (digit > 9)
         then result := non_digit
         else begin
           i := i + e*digit;
           e := e * 10;
           j := j - 1;
           end;
       end;  { while }
    stoi := result;
  end;  { procedure stoi }
    
    
{ Function match returns true if the string test is a valid abbreviation
  for the string keyword.
}
function match (var word : string;  var keyword : string) : boolean;
  var result : boolean;
    j : integer;
    c : char;
  begin
  result := true;
  if strlen(word) > strlen(keyword)
     then result := false
     else begin       { could still be abbreviation }
       j := 1;
       while (j <= strlen(word)) and (result = true) do begin
         c := word[j];          { get character from test string }
         if c >= 'a' then c := chr( ord(c) - ord(' ') );  { uppercase it }
         if c <> keyword[j]
            then result := false;
            j := j+1;
         end;  { while }
       end;  { could still be abbreviation }
  match := result;
  end;  { function match }
  
  
$page$
function lookup_key( table : keyword_table;  var word : string;
                      var value : integer;
                      var full_word : string ) : integer;
{

Searches the given keyword table for an entry that matches the given
keyword.

Inputs :  table - keyword table, which is array of records of type
                  keyword_entry.  These records consist of the keyword
                  string itself and the integer value assigned to the
                  keyword.
                  
          word -  keyword string to search for.
          
Outputs :  value -  If a match for the keyword is found, value receives
                    the integer value assigned to the keyword, found in
                    the keyword's record.
                    
           full_word - if a match for the keyword is found, full_word
                    receives the full keyword text.  For example, if
                    the word 'FO' matched the keyword 'FORMS' then
                    full_word would receive 'FORMS'.
                    
Returns:   Result code, one of

    success             match found for keyword, value contains the
                        keyword's assigned integer value.
                            
    ambig_keyword       given keyword matched more than one
                        table entry
     
    no_keyword          No table entry matched the given keyword.
          
}
  var i : integer;      { keyword position in table }
      result : integer;

begin
  i := 1;               { point to first keyword in table }
  result := no_keyword;
  while (result <> ambig_keyword) and (strlen(table[i].ks) <> 0) do begin
    if match(word, table[i].ks)
       then begin       { this keyword matches }
         if result = success
           then result := ambig_keyword         { already found match }
           else begin                   { this is first match yet }
             value := table[i].kv;
             full_word := table[i].ks;
             result := success;
             end;  { this is first match yet }
         end;  { this keyword matches }
       i := i + 1;
    end;  { while }
  lookup_key := result;
  end;  { procedure lookup_key }
    
$page$

procedure parse_init ( var prompt : string );
  begin
  clear_window(command_window);
  clear_window(help_window);
  write_window_string(command_window, prompt);
  clear_eol_window(command_window);
  parse_buffer := prompt;
  init_bufpos := strlen(prompt) + 1;
  cur_bufpos := init_bufpos;
  eol_parsed := false;
  end;  { procedure parse_init }
  
$page$
{

This procedure, parse, reads an argument of the given type from the
command input device (usually the console) and leaves it in the buffer
corresponding to that type (there is a buffer for each type of
argument).  If the argument is optional, as indicated by the second
parameter (named optional) being true, then the argument may or may
not be given by the user.  If it is not, the corresponding buffer will
remain unchanged.  This allows default values to be set by the
set_p_xxx procedures.  The value in the buffer may be read by the
get_p_xxx functions.

Error code will be left in parse_result.  A string with an parse error
message and the atom causing the error will be left in
parse_result_str.
}
procedure parse( arg : arg_type ;  opt : boolean );
  label 200,1000;
  var
    breakchar : char;
    read_result : integer;
    atom, report, title, kwd : string [80];
    echo : boolean;
    added_keyword, kwd_match : boolean;
    breakset : breakset_type;
    rpos, i : integer;
    bk : keyword_table_ptr;     { boolean TRUE/FALSE keyword table }
  
  procedure do_tab( var s : string );
    var pos : integer;
    begin
    pos := strlen(s);
    repeat
      pos := pos + 1;
      setstrlen(s,pos);
      s[pos] := ' ';
    until pos mod 8 = 0;
    end;  { procedure do_tab }
    
  begin
  parse_result := success;      { assume success for now }
  atom := '';
  cur_bufpos := init_bufpos;
  
  if arg = p_eol
     then begin         { parsing for EOL }
       if not eol_parsed
        then parse_result := not_confirmed;
        goto 1000;
       end
     else                 { not parsing for EOL }
       if eol_parsed then begin
          if not opt
            then parse_result := parse_after_eol;
          goto 1000;
          end;
     
  if arg = p_password
     then echo := false
     else echo := true;
     
200:
  if arg in [p_text, p_integer, p_boolean, p_password, p_keyword]
     then begin  { arg needs a string }
       if arg = p_text
          then breakset := ['?', #M]
          else breakset := ['?', ' ', ',', #M];
          read_result := read_break ( parse_buffer, init_bufpos,
                                      cur_bufpos, atom,
                                      breakset, breakchar, echo );
       
       case read_result of
          success:           begin
                             if breakchar = #M then eol_parsed := true;
                             end;
          
          back_past_field:   begin
                             parse_result := back_past_field;
                             goto 1000;
                             end;
          
          abort_line:        begin
                             parse_result := abort_line;
                             goto 1000;
                             end;
          
          null_string:       begin
                             if breakchar <> '?'
                               then begin
                                 parse_result := null_string;
                                 goto 1000;
                                 end;
                             end;
          end;  { case }
       end;  { arg needs a string }
     
  case arg of
     p_char     :  begin
                   arg_char := read_kbd_char;
                   end; { p_char }
                   
     p_integer  :  begin
                   parse_result := stoi( atom, arg_integer );
                   end; { p_integer }
                   
     p_text     :  begin
                   arg_text := atom;
                   end; { p_text }
                   
     p_boolean  :  begin
                   new(bk);
                   bk^[1].ks := 'FALSE';
                   bk^[1].kv := 0;
                   bk^[2].ks := 'TRUE';
                   bk^[2].kv := 1;
                   bk^[3].ks := '';
                   bk^[3].kv := 0;
                   parse_result := lookup_key( bk^, atom,
                                               arg_integer, arg_keyword );
                   arg_boolean := (arg_integer = 1);
                   end; { p_boolean }
     
     p_password :  begin
                   arg_text := atom;
                   end; { p_password }
     {
     Parse a keyword.  See if the given string matches any of the entries
     in parse_keyword_table.
     }
     p_keyword  :  begin
           if breakchar = '?'
             then begin         { help character typed }
               clear_window( help_window );
               i := 1;
               setstrlen(report,0);
               added_keyword := false;
               repeat
                 kwd := parse_keyword_table^[i].ks;
                 if (strlen(atom) = 0)
                   then kwd_match := true
                   else kwd_match := match(atom,kwd);
                 if (strlen(kwd) <> 0) and kwd_match 
                   then begin           { add keyword to output string }
                     do_tab(report);
                     rpos := strlen(report)+1;
                     strwrite(report,rpos,rpos,kwd);
                     if strlen(kwd) >=7 then do_tab(report);
                     if not added_keyword     { if haven't printed title yet }
                       then begin   { print title }
                         title := 'Keyword, one of the following:';
                         writeln_window_string(help_window, title);
                         added_keyword := true;
                         end;  { print title }
                     end;  { add keyword to output string }
                 
                 if (strlen(report) > 64)  or  (strlen(kwd) = 0)
                   then begin  { print the accumulated keyword list }
                     writeln_window_string(help_window,report);
                     setstrlen(report,0);
                     rpos := 1;
                     end; { print the accumulated keyword list }
                 i := i+1;
               until strlen(kwd) = 0;
               
               if not added_keyword     { if no keywords in list }
                 then begin  { print no match msg }
                   title := 'Keyword (no defined keywords match this input)';
                   writeln_window_string(help_window,title);
                   end;  { print no match msg }
         
         { remove the break character from the input buffer }
               setstrlen(parse_buffer, strlen(parse_buffer)-1);
               cur_bufpos := cur_bufpos - 1;
               clear_window(command_window);
               write_window_string(command_window,parse_buffer);
               goto 200;
               end  { help character typed }
             else begin         { parse the keyword }
               parse_result := lookup_key( parse_keyword_table^,
                                           atom,
                                           arg_integer,
                                           arg_keyword );
               arg_text := atom;
               end;  { parse the keyword }
           end;  { p_keyword }
  end; { case }
1000:
init_bufpos := cur_bufpos;

if not (parse_result in [success, abort_line, back_past_field, null_string])
  then begin            { set up parse error string }
    setstrlen(parse_result_str,0);
    strwrite(parse_result_str,1,rpos,'parsing "',atom,'"' );
    end;    { set up parse error string }
end;  { procedure parse }

end.  { module command }