Columbia Kermit/kermit.zip/norskdata/ndkcom.pas

Pascal/Delphi Source File | 2020-01-01 | 29KB | 769 lines

(* tab p; *)

(*
 *          Command-handling
 *
 *                for
 *
 *             ND-KERMIT
 *
 *)

(*
UTILITY ROUTINES:
*)

    function    AtoI ( IntString : NameType; VAR Int : integer ): boolean;
    (*
     * Abstract :   Converts the string in IntString to an integer.
     *      Returns false if IntString does
     *      not contain a valid integer.
     *)
    var     i        : integer;
            ch       : char;
            OkSoFar  : boolean;
    begin (* AtoI *)
        OkSoFar := IntString.Valid <= 4;(* Allow only up to 4 digits       *)
        Int := 0;                       (* in order to prevent overflow... *)
        for i := MinWord to IntString.Valid do
        begin
            ch := IntString.String(.i.);
            OkSoFar := OkSoFar and ( ( ch >= '0' ) and
                                     ( ch <= '9' ) );
            if OkSoFar then
                Int := Int * 10  + ord(ch) - ord('0');
        end;
        AtoI := OkSoFar;
    end;  (* AtoI *)

    function    OkFileSyntax( FileName : NameType ): boolean;
    begin (* OkFileSyntax *)
        (* This one could be complicated - leave it out so long. *)
        OkFileSyntax := true;
    end;  (* OkFileSyntax *)

(*
 *      END of Utility routines.
 *)

    procedure   Bell;
    begin
        write( ctl('G') );
    end;

    procedure   EditLine ( VAR Line : CmdLinType; RePrint : boolean );
    (*
     * Abstract :   Returns with a command line in Line.  The "Valid" field
     *      may be non-zero in order to continue editing of a line already
     *      containing parts of a complete command.
     *      Repeats until a non-empty command line has been input and terminated.
     *      Terminating characters may be <ESC>, "?" or <CR>.
     *      Editing characters recognized by this routine:
     *          ^H    - deletes last character and does BsSpBs.
     *          <DEL> - same
     *          ^A    - same (ND style).
     *          ^Q    - deletes hole line by doing BsSpBs several times.
     *                      (also ND style). (Unless Xon/Xoff is enabled).
     *          ^X    - same  (CP/M style).
     *          ^U    - same  (DEC style)
     *          ^W    - deletes last word (also ND style).
     *)
    type    CharTypes   =   (   CtlQ, CtlW, CtlA, CtlH, chQMark, chCR,
                                chESC, CtlX, CtlU, Del, OtherCtl, PrintAble );

    var     ch      : char;
            Ech     : CharTypes;
            i       : integer;
            PrevSpace,fin,DoTest,Done    : boolean;
            Returning : boolean;

        procedure   BsSpBs;
        begin
            write( ctl('H') , ' ' , ctl('H') );
        end;

        function    GetChar : char;
        (*
         * Abstract :   Read a character from the user's terminal.
         *      Hangs until a character has been typed, and returns this
         *      character as the function result.
         *)
        begin (* GetChar *)
            GetChar := inbt ( idev );
        end;  (* GetChar *)

    begin (* EditLine *)
        with Line do
        repeat
            Returning := false;
            if Valid >= MinName then
                PrevSpace := String(.Valid.) = ' '
            else
                PrevSpace := true;  (* previous character was <space> *)
            Cursor    := MinName;
            if RePrint then begin
                write( Prompt );
                for i := 1 to Valid do
                    write( String(.i.) );
            end;
            RePrint := true;
            repeat
                (* perform editing of Line.String *)
                fin := false;
                ch := GetChar;
                if ( ch = ctl('A') )
                 or( ch = ctl('H') )
                 or( ch = ctl('?') )   (* DEL *)
                then
                begin
                    if Valid >= 1 then begin
                        BsSpBs;
                        Valid := Valid - 1;
                    end else
                        Bell;
                    if Valid >= MinName then
                        PrevSpace := String(.Valid.) = ' '
                    else
                        PrevSpace := true;
                end else
                if ( ch = ctl('Q') )
                 or( ch = ctl('X') )
                 or( ch = ctl('U') )
                then
                begin
                    for i := 1 to Valid do
                        BsSpBs;
                    Valid := 0;
                    PrevSpace := true;
                end else
                if ch = ctl('W') then
                begin
                    if Valid <> 0 then
                    begin
                        (* back-space over blanks: *)
                        repeat
                            Done := false;
                            if ( Valid >= 1 ) then
                                if ( String(.Valid.) = ' ' ) then
                                begin
                                    BsSpBs;
                                    Valid := Valid - 1;
                                end else
                                    Done := true
                            else    Done := true;
                        until Done;
                        DoTest := Valid >= MinName;
                        if DoTest then
                        begin
                            (* back-space over word *)
                            while DoTest do
                            begin
                                if  String(.Valid.) <> ' ' then
                                begin
                                    BsSpBs;
                                    Valid := Valid - 1;
                                end
                                else
                                    DoTest := false;
                                DoTest := DoTest and (Valid >= MinName)
                            end;
                            PrevSpace := true;
                        end;
                    end else
                        Bell;
                end else
                if ch = ctl('M') (* CR *) then
                begin
                    fin := true;
                    Returning := Valid > 0;
                    if not Returning then
                        writeln;
                    Terminator := CR;
                end else
                if ch = '?' then
                begin
                    write('?');
                    fin := true;
                    Returning := true;
                    Terminator := QMark;
                end else
                if ch = ctl('[') then
                begin
                    fin := (Valid > 0) and (not PrevSpace);
                    if not fin then
                        Bell;
                    Returning := fin;
                    Terminator := ESC;
                end else
                if ( ch >= ctl('@') )
                and( ch < ' ')  (* other control characters *)
                then
                begin
                    if ch = ctl('T') then
                    begin
                        (* output debug info *)
                        writeln;
                        writeln('Valid =',Valid:2,' Cursor =',Cursor:2);
                        write('EndW  =',EndWord:2,' String :');
                        for i := MinName to Valid do
                            write(String(.i.));
                        writeln;
                        fin := true;
                    end else
                        Bell;
                end
                else
                (* ch is printable character *)
                begin
                    if Valid < MaxName then begin
                        Valid := Valid + 1;
                        String(.Valid.) := ch;
                        write( ch );
                    end else
                        Bell;
                    PrevSpace := ch = ' ';
                end;
            until fin;
        until Returning;
    end;  (* EditLine *)

    function    AtEnd ( VAR Buffer : CmdLinType ) : boolean;
    begin   (* AtEnd *)
        AtEnd :=   Buffer.Cursor = Buffer.Valid + 1;
    end;    (* AtEnd *)

    procedure   GetWord (   VAR Buffer  : CmdLinType;
                            VAR Word    : WordType );
    (*
     * Abstract :   Get the next word from "Buffer" - Buffer.Cursor points
     *      to next character to be read.  Leading blanks are stripped off.
     *      Only blanks are recognized as word separators.
     *      Buffer.Cursor is advanced to next non-blank or to end of string.
     *)
    var     i,j  : integer;
    begin (* GetWord *)
        with Buffer do
        begin
            i          := Cursor;                         (* Starting pos. *)
            PrevCursor := Cursor;
            while   (Buffer.String(.i.) = ' ')
                and ( i <= Valid )      (* Space over leading blanks *)
            do
                i := i + 1;
            j := MinWord;
            while ( i <= Valid ) and
                  ( String(.i.) <> ' ' ) and
                  ( j <= MaxWord ) do
            begin
                                           (* Copy word from buffer to Word. *)
                Word.String(.j.) := String(.i.);
                i := i + 1;                (* and increment pointers *)
                j := j + 1;
            end;
            Word.Valid := j - 1;
            EndWord    := i - 1;
            while ( String(.i.) <> ' ' )(* Advance cursor to next blank *)
              and ( i <= Valid )        (* or to end *)
            do
                i := i + 1;
            if i = Valid then
                Cursor := i + 1
            else
                Cursor := i;
        end;  (* With *)
    end;  (* GetWord *)

    procedure   GetName (   VAR Buffer  : CmdLinType;
                            VAR Name    : NameType );
    (*
     * Abstract :   Get the next item from "Buffer" - Buffer.Cursor points
     *      to next character to be read.  Leading blanks are stripped off.
     *      Only blanks are recognized as word separators.
     *      Buffer.Cursor is advanced to next non-blank or to end of string.
     *)
    var     i,j  : integer;
    begin (* GetName *)
        with Buffer do
        begin
            i          := Cursor;                         (* Starting pos. *)
            PrevCursor := Cursor;
            while   (Buffer.String(.i.) = ' ')
                and ( i <= Valid )      (* Space over leading blanks *)
            do
                i := i + 1;
            j := MinName;
            while ( i <= Valid ) and
                  ( String(.i.) <> ' ' ) and
                  ( j <= MaxName ) do
            begin
                                           (* Copy word from buffer to Word. *)
                Name.String(.j.) := String(.i.);
                i := i + 1;                (* and increment pointers *)
                j := j + 1;
            end;
            Name.Valid := j - 1;
            EndWord    := i - 1;
            while ( String(.i.) <> ' ' )(* Advance cursor to next blank *)
              and ( i <= Valid )        (* or to end *)
            do
                i := i + 1;
            if i = Valid then
                Cursor := i + 1
            else
                Cursor := i;
        end;  (* With *)
    end;  (* GetName *)

    procedure   WordToSymbol (  Word         : WordType;
                                VAR Symbol   : VocabType;
                                VAR Status   : MatchType;
                                VAR Matching : VocabSet;
                                VAR Expect   : VocabSet );
    (*
     * Abstract :   Translates from Word to Symbol.  Status is set according
     *      to the result of the match.  The matching words become members
     *      of the set Matching.
     *)
    var     MatchFound, ThisWordMatch : boolean;
            i,j         : integer;
            Index,RetVal: VocabType;

        function    WordsMatch ( Abbrev , Reference : WordType ):boolean;
        var     i : integer;
                Match : boolean;
        begin (* WordsMatch *)
            Match := true;
            if ( Abbrev.Valid <= Reference.Valid ) and
               ( Abbrev.Valid >= MinWord )
            then
                for i := MinWord to Abbrev.Valid do
                    Match := Match and
                        ( uc(Abbrev.String(.i.) ) = Reference.String(.i.))
            else
                Match := False;
            WordsMatch := Match;
        end; (* WordsMatch *)

    begin (* WordToSymbol *)
        RetVal := ExitSym;  (* in order to avoid ILLEGAL SUBRANGE ASSIGNMENT *)
        Matching := (. .);
        Status := NoMatch;
        for Index := First( VocabType ) to Last( VocabType ) do
        begin
            if WordsMatch ( Word , VocabTable(.Index.) ) then
            begin
                if Index in Expect then
                begin
                    Matching := Matching + (. Index .);
                    if Status = NoMatch then
                    begin
                        Status := Exact;
                        Symbol := Index;
                    end else
                        Status := Ambigous;
                end;
            end;
        end;
    end;  (* WordToSymbol *)

    procedure   GetCmd (    VAR Verb, Noun, Adj : VocabType;
                            VAR ParBlock        : ParType  );
    (*
     *  Abstract :  Get a new command from the user's terminal.
     *      Does appropriate checking so that returned values are consistent.
     *      Repeats until valid command is given.
     *      Does the following:
     *          "?" preceded by at least a space:
     *              Types out the expected parameters and continues
     *              editing of same line.
     *          "?" not preceded by a space:
     *              Types out the matching parameters.
     *              If no match is found, works as if the last word
     *              had not been typed.  Continues editing of current
     *              command.
     *          <ESC> not preceded by a space:
     *              Deabbreviates the current word. If no match is
     *              found, acts as if "?" had been typed instead.
     *              Continues editing of current command.
     *          <ESC> preceded by a space is not allowed.
     *              (Taken care of by EditLine.)
     *)
    var     Expect  : VocabSet;
            Sym     : VocabType;
            Word    : WordType;
            ValidCommand : boolean;
            RePrint : boolean;
            Buffer  : CmdLinType;

        procedure   BackWord;
        begin
            if Buffer.PrevCursor = MinName then
                Buffer.Valid := MinName - 1
            else
                Buffer.Valid := Buffer.PrevCursor;
        end;

        procedure   MakeEndBlank( VAR Buffer : CmdLinType );
        begin
            with Buffer do
                if ( Valid >= MinName ) and ( Valid < MaxName ) then
                    if String(.Valid.) <> ' ' then
                    begin
                        String(.Valid + 1.) := ' ';
                        Valid := Valid + 1;
                    end;
        end;

        function    ParseWord ( Expect  : VocabSet;
                            VAR Symbol  : VocabType ): boolean;
        (*
         *
         *)
        var     Matching    : VocabSet;
                Status      : MatchType;
                RetVal      : boolean;

            procedure   WriteWord( Word : WordStr; Valid : integer );
            var     i : integer;
            begin
                for i := MinWord to Valid do
                    write( Word(.i.) );
            end;

            procedure   OneOf( These : VocabSet );
            const   LettersPrWord   =   8;
                    WordsPrLine     =   6;
                    InitSpace       =   4;
            var     Index : VocabType;
                    WordNo: integer;
                    i     : integer;

                procedure   PrintWord( This : VocabType );
                var     Need,i : integer;
                begin (* PrintWord *)
                    Need := 1 + ( VocabTable(.This.).Valid + 2 )
                                div LettersPrWord;
                    if WordNo + Need > WordsPrLine then
                    begin
                        writeln;
                        write(' ':InitSpace);
                        WordNo := 0;
                    end;
                    WordNo := WordNo + Need;
                    with VocabTable(.This.) do
                    begin
                        WriteWord( String, Valid  );
                        for i := ( ( Valid + 1 ) mod LettersPrWord )
                                 to LettersPrWord
                        do
                            write( ' ' );
                    end;
                end;  (* PrintWord *)

            begin (* OneOf *)
                writeln(' Use one of the following:');
                WordNo := 0;
                write(' ':InitSpace);
                for Index := First( VocabType ) to Last( VocabType ) do
                    if Index in These then
                    begin
                        PrintWord( Index );
                    end;
                    writeln;
            end;  (* OneOf *)

            procedure   Deabbr( Word : WordType;
                                Symbol : VocabType;
                            VAR Buffer : CmdLinType );
            var     i,j : integer;
            begin (* Deabbr *)
                with Buffer do
                begin
                    j := -1;
                    for i := Word.Valid + 1 to VocabTable(. Symbol .).Valid do
                    begin
                        j := i - Word.Valid - 1;
                        ch := VocabTable(. Symbol .).String(.i.);
                        String(. j + Cursor .):= ch;
                        write(ch);
                    end;
                    String(. j + Cursor + 1 .) := ' ';
                    write(' ');
                    Valid := j + Cursor + 1;
                end;
                RePrint := false;
            end;  (* Deabbr *)

        begin (* ParseWord *)
            if AtEnd( Buffer ) then
            begin
                case Buffer.Terminator of
                    QMark,Cr:
                        with Buffer do
                        begin
                            if Terminator = Cr then
                                write(' Not confirmed.');
                            OneOf( Expect );
                            MakeEndBlank( Buffer );
                        end;
                    Esc     :   ;
                end;
                RetVal := false;
            end else begin
                GetWord ( Buffer, Word );
                WordToSymbol ( Word, Symbol, Status, Matching, Expect );
                case Status of
                    Exact   :
                        begin
                            if AtEnd( Buffer ) and ( Buffer.Terminator = Esc )
                            then
                            begin
                                RetVal := false;
                                Deabbr( Word, Symbol, Buffer );
                            end else
                                RetVal := true;
                        end;
                    Ambigous:
                        begin
                            RetVal := false;
                            if
                                not AtEnd( Buffer )
                                or ( Buffer.Terminator <> QMark )
                            then
                            begin
                                write(' Ambigous word: "');
                                WriteWord( Word.String, Word.Valid );
                                write('".');
                            end;
                            OneOf( Matching );
                            Buffer.Valid := Buffer.EndWord;
                        end;
                    NoMatch :
                        begin
                            RetVal := false;
                            write(' No match for word: "');
                            WriteWord( Word.String, Word.Valid );
                            write('"');
                            OneOf( Expect );
                            BackWord;
                        end;
                end;
            end;
            ParseWord := RetVal;
        end;  (* ParseWord *)

        function    TestConfirm: boolean;
        begin (* TestConfirm *)
            if not AtEnd( Buffer ) then
            begin
                writeln(' No extra parameters needed.');
                Buffer.Valid := Buffer.EndWord;
                TestConfirm := false;
            end else
                if Buffer.Terminator <> Cr then
                begin
                    writeln(' Confirm with CR.');
                    Buffer.Valid := Buffer.EndWord;
                    TestConfirm := false;
                end
                else
                    TestConfirm := true;
        end; (* TestConfirm *)

        function    GetInt( VAR ParBlock : ParType ): boolean;
        begin (* GetInt *)
            if not AtEnd( Buffer ) then
            begin
                GetName( Buffer, ParBlock.Name );
                if not AtoI( ParBlock.Name, ParBlock.int ) then
                begin
                    GetInt := False;
                    writeln(' Illegal number syntax.');
                    BackWord;
                end;
            end else
            begin
                writeln(' Confirm with valid integer.');
                GetInt := false;
            end;
            MakeEndBlank( Buffer );
        end;  (* GetInt *)

        function    GetFileName (   VAR FileName : NameType ): boolean;
        (*
         * Abstract :   Get a filename from the input line-buffer.
         *      Checks for valid syntax of the filename, but does not attempt
         *      to open the file.
         *)
        var     RetVal : boolean;
                i      : integer;
        begin (* GetFileName *)
            if AtEnd ( Buffer ) then begin
                writeln(' File name required.');
                MakeEndBlank( Buffer );
                RetVal := false;
            end else begin
                GetName ( Buffer, FileName );
                (* Convert filename to upper case. *)
                for i := MinName to FileName.Valid do
                    FileName.String(.i.) := uc( FileName.String(.i.) );
                RetVal := OkFileSyntax( FileName );
            end;
            GetFileName := RetVal;
        end;  (* GetFileName *)

        function    GetSetParameter (   VAR Noun, Adj : VocabType;
                                        VAR ParBlock  : ParType ): boolean;
        (*
         * Abstract :   Get a SET parameter.
         *      The verb SET has already been fetched from "Buffer".
         *)
        var     Valid : boolean;

            function    GetDbgParameter (   VAR Adj       : VocabType;
                                            VAR ParBlock  : ParType ): boolean;
            (*
             * Abstract :   Get a valid parameter for SET DEBUG.
             *)
            var     Valid : boolean;
            begin (* GetDbgParameter *)
                Expect := (. OnSym, OffSym, LogFileSym, NoLogFileSym .);
                Valid := ParseWord ( Expect, Adj );
                if Valid then
                    case Adj of
                        OnSym   :   Valid := TestConfirm;
                        OffSym  :   Valid := TestConfirm;
                        LogFileSym  :
                                    Valid := GetFileName ( ParBlock.Name );
                        NoLogFileSym:   Valid := TestConfirm;
                    end;
                GetDbgParameter := Valid;
            end;  (* GetDbgParameter *)

            function    GetRSParameter (    VAR Adj       : VocabType;
                                            VAR ParBlock  : ParType ): boolean;
            (*
             * Abstract :   Get a valid SET SEND or SET RECEIVE parameter.
             *      Returns true if syntactically correct
             *      command has been entered.
             *)
            var     Valid : boolean;
            begin (* GetRSParameter *)
                Expect := (. TimeOutSym .);
                Valid := ParseWord ( Expect , Adj );
                if Valid then
                    case Adj of
                        TimeOutSym :
                            Valid := GetInt ( ParBlock );
                    end;
                GetRSParameter := Valid;
            end;  (* GetRSParameter *)

            function    GetUse8( VAR Adj : VocabType ): boolean;
            var     Valid : boolean;
                    Expect: VocabSet;
            begin(* GetUse8 *)
                Expect := (. AutoSym, OffSym .);
                Valid := ParseWord( Expect, Adj );
                if Valid then
                    Valid := TestConfirm;
                GetUse8 := Valid;
            end; (* GetUse8 *)

            function    GetFWarn( VAR Adj : VocabType ): boolean;
            var     Expect : VocabSet;
                    Valid  : boolean;
            begin(* GetFWarn *)
                Expect := (. OnSym, OffSym .);
                Valid := ParseWord( Expect, Adj );
                if Valid then
                    Valid := TestConfirm;
                GetFWarn := Valid;
            end; (* GetFWarn *)

        begin (* GetSetParameter *)
            Expect := (.    DbgSym, DelaySym, (*  LogFileSym, *)
                            FWarnSym, RcvSym, SendSym, Use8Sym .);
            Valid := ParseWord ( Expect, Noun );
            if Valid then
                case Noun of
                    DbgSym  :
                        Valid := GetDbgParameter( Adj, ParBlock );
                    DelaySym:
                        Valid := GetInt ( ParBlock );
                    LogFileSym: ;   (* Only to be used if this is a LOCAL Kermit *)
                                    (* -- which this one can't be.               *)
                    RcvSym, SendSym :
                        Valid := GetRSParameter( Adj, ParBlock );
                    Use8Sym :
                        Valid := GetUse8( Adj );
                    FWarnSym:
                        Valid := GetFWarn( Adj );
                end;
            GetSetParameter := Valid;
        end;  (* GetSetParameter *)

    begin (* GetCmd *)
        Descf;
        Buffer.Valid := 0;
        RePrint := true;
        ValidCommand := false;
        repeat
            EditLine ( Buffer, RePrint );
            RePrint := true;
            Expect := (.    ExitSym, HelpSym, QuitSym, RcvSym,
                            SendSym, SetSym,  StatisticsSym .);
            ValidCommand := ParseWord ( Expect, Verb );
            if ValidCommand then begin
                case Verb of
                    ExitSym, QuitSym :  ValidCommand := TestConfirm;
                    HelpSym :   ValidCommand := TestConfirm;
                    RcvSym  :   ValidCommand := TestConfirm;
                    SendSym :
                        ValidCommand := GetFileName( ParBlock.Name );
                    SetSym  :
                        ValidCommand := GetSetParameter( Noun, Adj, ParBlock );
                    StatisticsSym :
                        ValidCommand := TestConfirm;
                end;
            end;
        until ValidCommand;
        Eescf;
    end;  (* GetCmd *)

    procedure   InitVocab;
    (*
     *  Abstract :  Initializes the vocabulary and stores it in
     *              the global variable VocabTable.
     *)
    var     Index : VocabType;
    begin (* InitVocab *)
        VocabTable (. ExitSym       .).String := 'EXIT$';
        VocabTable (. QuitSym       .).String := 'QUIT$';
        VocabTable (. RcvSym        .).String := 'RECEIVE$';
        VocabTable (. SendSym       .).String := 'SEND$';
        VocabTable (. SetSym        .).String := 'SET$';
        VocabTable (. DbgSym        .).String := 'DEBUG$';
        VocabTable (. OnSym         .).String := 'ON$';
        VocabTable (. OffSym        .).String := 'OFF$';
        VocabTable (. LogFileSym    .).String := 'LOG-FILE$';
        VocabTable (. DelaySym      .).String := 'DELAY$';
        VocabTable (. TimeOutSym    .).String := 'TIMEOUT$';
        VocabTable (. StatisticsSym .).String := 'STATISTICS$';
        VocabTable (. HelpSym       .).String := 'HELP$';
        VocabTable (. LogFileSym    .).String := 'LOG-FILE$';
        VocabTable (. NoLogFileSym  .).String := 'NO-LOG-FILE$';
        VocabTable (. AutoSym       .).String := 'AUTO$';
        VocabTable (. Use8Sym       .).String := 'USE-8-BIT-QUOTE$';
        VocabTable (. FWarnSym      .).String := 'FILE-WARNING$';
        for Index := First( VocabType ) to Last( VocabType ) do
            with VocabTable(.Index.) do
            begin
                Valid := MinWord;
                while String(.Valid.) <> '$' do
                    Valid := Valid + 1;
                Valid := Valid - 1;
            end;
    end;  (* InitVocab *)