Columbia Kermit/kermit.zip/perqb/pq2par.pas

Pascal/Delphi Source File | 2020-01-01 | 42KB | 1,322 lines

module KermitParameters;

exports

imports KermitGlobals from KermitGlobals;
imports MenuUtils from MenuUtils;
imports FileDefs from FileDefs;

const   MaxParts     =   30;

{ NBNBNB!! These type definitions MUST ALWAYS correspond to the
  sequence of the menu items in the Kermit.MENU file }
type

        MainCommType =  (NoMainComm,
                         MainHelp,
                         MainSend,
                         MainReceive,
                         MainGet,
                         MainExit,
                         MainQuit,
                         MainPush,
                         MainTake,
                         MainConnect,
                         MainBye,
                         MainFinish,
                         MainRemote,
                         MainLocal,
                         MainServer,
                         MainSet,
                         MainShow,
                         MainStatus,
                         MainUsage,
                         MainNotFound,
                         MainNotUnique,
                         MainEmptyLine,
                         MainSwitch,
                         MainIllegChar);

        TermCommType =  (NoTermComm,
                         TermHelp,
                         TermQuit,
                         TermSetBaud,
                         TermSetStop,
                         TermSetParity,
                         TermSaveFile,
                         TermOnSave,
                         TermOffSave,
                         TermOnXonXoff,
                         TermOffXonXoff);

        SetCommType =   (NoSetComm,
                         SetHelp,
                         SetBaud,
                         SetParity,
                         SetStop,
                         SetSend,
                         SetReceive,
                         SetFileHeader,
                         Set8BitQuote,
                         SetUse8BitQuote,
                         SetRepFix,
                         SetUseRepFix,
                         SetFileWarning,
                         SetRetry,
                         SetLogFile,
                         SetLog,
                         SetDebugging,
                         SetBreakTime,
                         SetEscape,
                         SetNotFound,
                         SetNotUnique,
                         SetEmptyLine,
                         SetSwitch,
                         SetIllegChar);

        SendRecType =   (NoSendRec,
                         SRHelp,
                         SRPacketLength,
                         SRCtlQuote,
                         SRStartOfPacket,
                         SRTimeOut,
                         SREndOfLine,
                         SRPadding,
                         SRPadChar);

        FHeaderType =   (NoFHeader,
                         FHHelp,
                         FHNord,
                         FHNoTrunc,
                         FHTrunc,
                         FHTrans);

        TransType   =   (NoTrans,
                         TransHelp,
                         TransLower,
                         TransUpper,
                         TransOff);

        RetryType   =   (NoRetryType,
                         RetryHelp,
                         RetryInitial,
                         RetryPacket,
                         RetryCommand);

        OnOffType   =   (NoOnOff,
                         OnOffHelp,
                         On,
                         Off,
                         OnOfNotFound,
                         OnOfNotUnique,
                         OnOfEmptyLine,
                         OnOfSwitch,
                         OnOfIllegChar);

        EmptyType   =   (NoEmpty,
                         EmptyHelp,
                         EmptyAndVoid,
                         EmpNotFound,
                         EmpNotUnique,
                         EmptyLine,
                         EmptySwitch,
                         EmptyIllegChar);

        SpeedType   =   (NoSpeed,
                         SpHelp,
                         Sp110,
                         Sp150,
                         Sp300,
                         Sp600,
                         Sp1200,
                         Sp2400,
                         Sp4800,
                         Sp9600,
                         SpNotFound,
                         SpNotUnique,
                         SpEmptyLine,
                         SpSwitch,
                         SpIllegChar);

        ParityType  =   (NoParComm,
                         ParHelp,
                         NoKParity,
                         EvenKParity,
                         OddKParity,
                         MarkKParity,
                         SpaceKParity,
                         ParNotFound,
                         ParNotUnique,
                         ParEmptyLine,
                         ParSwitch,
                         ParIllegChar);


        StopType    =   (NoStopComm,
                         StopHelp,
                         SyncrCmd,
                         Stop1Cmd,
                         Stop1x5Cmd,
                         Stop2Cmd,
                         StopNotFound,
                         StopNotUnique,
                         StopEmptyLine,
                         StopSwitch,
                         StopIllegChar);

        TruncPart   =   1..MaxParts;
        TListType   =   array [TruncPart] of integer;
const
        NMainComm   =   ord(MainNotFound)-1;
        NTermComm   =   ord(TermOffXonXoff);
        NSetComm    =   ord(SetNotFound)-1;
        NOnOff      =   ord(OnOfNotFound)-1;
        NSpeeds     =   ord(SpNotFound)-1;
        NParityComm =   ord(ParNotFound)-1;
        NStopComm   =   ord(StopNotFound)-1;
        NEmptyComm  =   ord(EmpNotFound)-1;

var
    RootMenu        :   pMenuEntry; { Pointer to root of menu structure }

    Parity          :   ParityType; { Current parity setting }
    Baud            :   SpeedType;  { Current baud rate setting }
    StopBits        :   StopType;   { Current number of stop bits }

    SendSOH         :   char;       { Start-Of-Packet to send }
    SendPSize       :   integer;    { Packet size he wants }
    SendTimeOut     :   integer;    { Time-out he wants }
    SendNPad        :   integer;    { Number of padding-characters he wants }
    SendPadChar     :   char;       { The padding character he wants }
    SendEOL         :   char;       { The EOL he wants }
    SendQuote       :   char;       { The Quote char he wants }

    RecSOH          :   char;       { Start-Of-Packet I want }
    RecPSize        :   integer;    { Max packet size I can handle }
    RecTimeOut      :   integer;    { time-out I want }
    RecNPad         :   integer;    { Padding I want }
    RecPadChar      :   char;       { Padchar I want }
    RecEOL          :   char;       { End-Of-Line I propose }
    RecQuote        :   char;       { Control quote I propose }

    Use8Quote       :   boolean;    { Is 8-bit quoting in use? }
    Bit8Quote       :   char;       { 8-bit Quote character to be used }

    UseRepFix       :   boolean;    { Is repeat prefixing in use? }
    RepFix          :   char;       { Repeat prefix to be used }

    NowUse8Quote,
    NowUseRepFix    :   boolean;    { - enabled during this transfer?? }

    Debug           :   boolean;    { Enable debug output }
    FileWarning     :   boolean;    { Avoid overwriting existing file if TRUE}
    XonXoff         :   boolean;    { use XonXoff handshaking }
    FileSave        :   boolean;    { Log terminal session to file }
    SaveFile        :   PathName;

    Nord            :   boolean;    { Translate file names for NORD }
    NumTrunc,
    OldTrunc        :   integer;    { Truncation list }
    TruncList       :   TListType;
    Translate       :   TransType;  { Case translation }

    MaxTryPack      :   Integer;    { Retry limits before giving up }
    MaxTryInit      :   Integer;
    MaxTryComm      :   Integer;

    LongWait        :   Integer;

    LocalKermit     :   boolean;    { Is this Kermit a local one? }
    DisableTimOut   :   boolean;    { TRUE if timeout is disabled }
    Idev,Odev       :   integer;    { Which devices to use for line }

    LegalPackets,                           { valid packet types }
    CtlMapping,                             { Control character mapping }
    OkQuote,                                { Valid quote characters }
    Quotes          :   set of char;        { Quotes presently in use }

    EscKey          :   char;       { Char to type to escape CONNECT }

    procedure   SetInitPars( var Pack : Packet );
    procedure   ReadPars ( VAR Pack : Packet );
    procedure   InitParameters;
    procedure   CleanupParameters;

    procedure   SetCommand( PList : pPListEntry );
    procedure   ShowCommand( PList : pPListEntry );
    procedure   StatusCommand;

    procedure   ShowKey( Ch : char );


{================} private {=================}

imports KermitLineIO from KermitLineIO;
imports KermitConnect from KermitConnect;
imports IOErrors from IOErrors;
imports IO_Unit from IO_Unit;
imports IO_Others from IO_Others;

    exception NotInt;

    procedure EatSpaces( var S : String );
    begin
        if S<>'' then
            while (S[1]=' ') and (length(S)>1) do
                Delete( S, 1, 1);
        if S=' ' then
            S := '';
    end;

    function StrToInt( VAR S : String ):integer;
    var I :integer;
        done : boolean;
    begin
        I := 0;
        done := false;
        EatSpaces( S );
        if S='' then
            raise NotInt
        else begin
            if not (S[1] in ['0'..'9']) then
                raise NotInt
            else
                repeat
                    if not (S[1] in ['0'..'9']) then
                        done := true
                    else begin
                        I := I*10 + ord(S[1]) - ord('0');
                        Delete( S, 1, 1);
                        Done := S='';
                    end;
                until done;
        end;
        StrToInt := I;
    end;

    function CtrlChar( S:String ):integer;

        handler NotInt;
        begin
            CtrlChar := -1;
            exit( CtrlChar );
        end;

    var R : integer;
    begin
        if length( S )=0 then
            R := -1
        else
            if length( S )=1 then
                R := ord( S[1] )
            else
                if S[1]='#' then begin
                    Delete( S, 1, 1);
                    R := StrToInt( S );
                end else
                    if S[1]='^' then
                        if S[2] in ['@'..'^'] then
                            R := ord( Ctl(S[2]) )
                        else
                            R := -1;
        CtrlChar := R;
    end;

    procedure DoSetRetry( PList : pPListEntry );
    var Val : integer;

        handler NotInt;
        begin
            writeln('Number of retries not numeric!');
            exit( DoSetRetry );
        end;

    begin
        Val := StrToInt( PList^.NextPList^.Arg );
        if not (Val in [1..30]) then
            writeln('Illegal  number of retries!')
        else
            case recast( PList^.Selection, RetryType ) of

                RetryInitial:   MaxTryInit := Val;
                RetryPacket:    MaxTryPack := Val;
                RetryCommand:   MaxTryComm := Val;
                otherwise:      ;
            end;
    end;


    procedure SetPSize( Arg : String; var PSize : integer );
    var Val : integer;

        handler NotInt;
        begin
            writeln('Packet length not numeric!');
            exit( SetPSize );
        end;

    begin
        Val := StrToInt( Arg );
        if not (Val in [10..94]) then
            writeln( 'Illegal packet length!')
        else
            PSize := Val;
    end;


    procedure SetQuote( Arg : String; var Quote : char );
    var Val : integer;
    begin
        Val := CtrlChar( Arg );
        if Val=-1 then
            writeln( 'Control quote ordinal value is not numeric!' )
        else
            if not ( chr(Val) in OkQuote ) then
                writeln( 'Illegal quote character')
            else
            if chr(Val) in Quotes then
                writeln( 'Character is already in use as another quote' )
            else
                Quote := chr( Val );
    end;


    procedure SetSOH( Arg : String; var SOH : char );
    var Val : integer;
    begin
        Val := CtrlChar( Arg );
        if Val=-1 then
            writeln( 'Start-of-packet ordinal value is not numeric!' )
        else
            if not ( Val in [0..31,127,128..159,255]) then
                writeln
                    ('Start-of-packet character must be a control character!')
            else
                SOH := chr( Val );
    end;


    procedure SetTimeOut( Arg : String; var TimeOut : integer );
    var Val : integer;

        handler NotInt;
        begin
            writeln('Timeout interval not numeric!');
            exit( SetTimeOut );
        end;

    begin
        if Arg='' then
            TimeOut := 0
        else begin
            Val := StrToInt( Arg );
            if not (Val in [0..94]) then
                writeln( 'Illegal timeout interval!')
            else
                TimeOut := Val;
        end;
    end;


    procedure SetEOL( Arg : String; var EOL : char );
    var Val : integer;
    begin
        Val := CtrlChar( Arg );
        if Val=-1 then
            writeln( 'End-of-line ordinal value is not numeric!' )
        else
            EOL := chr( Val );
    end;


    procedure SetNPad( Arg : String; var NPad : integer );
    var Val : integer;

        handler NotInt;
        begin
            writeln('Padding value not numeric!');
            exit( SetNPad );
        end;

    begin
        Val := StrToInt( Arg );
        if not (Val in [0..94]) then
            writeln( 'Illegal padding value!')
        else
            NPad := Val;
    end;


    procedure SetPadChar( Arg : String; var PadChar : char );
    var Val : integer;
    begin
        Val := CtrlChar( Arg );
        if Val=-1 then
            writeln( 'Pad character ordinal value is not numeric!' )
        else
            PadChar := chr( Val );
    end;


    procedure ShowKey( Ch : char );
    begin
        if Land( ord( Ch ), #200 ) <>0 then begin
            write( 'CTRL-' );
            ch := chr( land( ord( ch ), #177 ) );
        end;
        if Ch='' then write('OOPS') else
        if Ch='' then write('INS') else
        if Ch='    ' then write('TAB') else
        if Ch='' then write('HELP') else
        if Ch='' then write('DEL') else
        if Ch='' then write('BACKSPACE') else begin
            if Ch in ['A'..'Z'] then
                write( 'SHIFT-' );
            write( Ch );
        end;
    end;


    procedure SetEscChar( Arg : String );
    var Val : integer;
    begin
        if Arg='' then begin
            IOKeyClear;
            write( 'Press the key which you want as escape character:' );
            while IOCRead( KeyBoard, EscKey ) <> IOEIOC do ;
            writeln;
            write( 'Escape character set as: ');
            ShowKey( EscKey );
            writeln;
        end else begin
            Val := CtrlChar( Arg );
            if Val=-1 then
                writeln( 'Escape character ordinal value is not numeric!')
            else
                EscKey := chr( Val );
        end;
    end;


    procedure DoSetSend( PList : pPListEntry );
    var TempQuote : set of char;
    begin
        with PList^ do
        case recast( Selection, SendRecType ) of
            SRPacketLength: SetPSize( NextPList^.Arg, SendPSize );
            SRCtlQuote:
                begin
                    TempQuote := Quotes;
                    Quotes := [];   { SendQuote may be same as 8-bi or repeat }
                    SetQuote( NextPList^.Arg, SendQuote );
                    Quotes := TempQuote;
                end;
            SRStartOfPacket:SetSOH( NextPList^.Arg, SendSOH );
            SRTimeOut:      SetTimeOut( NextPList^.Arg, SendTimeOut );
            SREndOfLine:    SetEOL( NextPList^.Arg, SendEOL );
            SRPadding:      SetNPad( NextPList^.Arg, SendNPad );
            SRPadChar:      SetPadChar( NextPList^.Arg, SendPadChar );
            otherwise:      ;
        end;
    end;

    procedure DoSetReceive( PList : pPListEntry );
    begin
        with PList^ do
        case recast( Selection, SendRecType ) of
            SRPacketLength: SetPSize( NextPList^.Arg, RecPSize );
            SRCtlQuote:
                begin
                    Quotes := Quotes - [RecQuote];
                    SetQuote( NextPList^.Arg, RecQuote );
                    Quotes := Quotes + [RecQuote];
                end;
            SRStartOfPacket:SetSOH( NextPList^.Arg, RecSOH );
            SRTimeOut:      SetTimeOut( NextPList^.Arg, RecTimeOut );
            otherwise:      ;
        end;
    end;

    procedure DoTruncation( PList : pPListEntry );
    var NewTrunc : integer;
        NewTList : TListType;

        handler NotInt;
        begin
            writeln('Truncation value must be an integer!');
            exit( DoTruncation );
        end;

    begin
        with PList^ do
            if Arg='' then
                NumTrunc := OldTrunc
            else begin
                NewTrunc := 0;
                EatSpaces( Arg );
                while Arg<>'' do begin
                    NewTrunc := NewTrunc + 1;
                    NewTList[NewTrunc] := StrToInt( Arg );
                    EatSpaces( Arg );
                    if Arg<>'' then
                        if Arg[1]=',' then
                            Delete( Arg, 1, 1 );
                     EatSpaces( Arg );
                end;
                NumTrunc := NewTrunc;
                OldTrunc := NewTrunc;
                TruncList := NewTList;
            end;
    end;

    procedure DoSetFHeader( PList : pPListEntry );
    Const   NordWarning =   'Warning: NORD transformation is ON!';
            AsLongAs    =
            'is temporarily active for as long as NORD is ON in any case!';
    begin
        with PList^ do
        case recast( Selection, FHeaderType ) of
            FHNord:
                Nord := recast( NextPList^.Selection, OnOffType) =On;
            FHNoTrunc:
                begin
                    OldTrunc := NumTrunc;
                    NumTrunc := 0;
                    if Nord then begin
                        writeln( NordWarning );
                        writeln('  NO-TRUNCATE ', AsLongAs );
                        writeln;
                    end;
                end;
            FHTrunc:
                begin
                    DoTruncation( NextPList );
                    if Nord then begin
                        writeln( NordWarning );
                        write  ('  TRUNCATE will not take effect until');
                        writeln(' NORD is turned OFF!');
                        writeln;
                    end;
                end;
            FHTrans:
                begin
                    Translate := recast( NextPList^.Selection, TransType );
                    if Nord then begin
                        writeln( NordWarning );
                        writeln( '  CONVERT UPPER ', AsLongAs );
                        writeln;
                    end;
                end;
            otherwise: ;
        end;
    end;

    procedure DoSet8Quote( PList : pPListEntry );
    var ch : char;
    begin
        Quotes := Quotes - [Bit8Quote];
        if PList^.Arg='' then
            Bit8Quote := '&'
        else begin
            ch := PList^.Arg[1];
            if ch in OkQuote then begin
                if ch in Quotes then
                    writeln
                    ('Character is already in use as another quote' )
                else
                    Bit8Quote := ch;
            end
            else
                writeln('Illegal quote character!');
        end;
        Quotes := Quotes + [Bit8Quote];
    end;

    procedure DoSetRepFix( PList : pPListEntry );
    var ch : char;
    begin
        Quotes := Quotes - [RepFix];
        if PList^.Arg='' then
            RepFix := '&'
        else begin
            ch := PList^.Arg[1];
            if ch in OkQuote then begin
                if ch in Quotes then
                    writeln
                    ('Character is already in use as another quote' )
                else
                    RepFix := ch;
            end
            else
                writeln('Illegal quote character!');
        end;
        Quotes := Quotes + [RepFix];
    end;

    procedure   SetCommand( PList : pPListEntry );
    var SetParm : SetCommType;
    begin
        SetParm := recast( PList^.Selection, SetCommType );
        PList := PList^.NextPList;

        case SetParm of

            SetStop:
                begin
                    StopBits := recast( PList^.Selection, StopType );
                    RefreshStopBits;
                end;

            SetParity:
                begin
                    Parity := recast( PList^.Selection, ParityType );
                    RefreshParity;
                end;

            SetBaud:
                begin
                    Baud := recast( PList^.Selection, SpeedType);
                    RefreshBaud;
                end;

            SetFileWarning:
                begin
                    FileWarning :=
                        recast( PList^.Selection, OnOffType ) = On;
                end;

            SetLog:
                begin
                    FileSave :=
                        recast( PList^.Selection, OnOffType ) = On;
                end;

            SetLogFile:
                begin
                    SetSaveFile( PList^.Arg );
                end;

            SetDebugging:
                begin
                    Debug :=
                        recast( PList^.Selection, OnOffType ) = On;
                end;

            SetSend:
                DoSetSend( PList );

            SetReceive:
                DoSetReceive( PList );

            SetFileHeader:
                DoSetFHeader( PList );

            Set8BitQuote:
                DoSet8Quote( PList );

            SetUse8BitQuote:
                Use8Quote := recast( PList^.Selection, OnOffType ) = On;

            SetRepFix:
                DoSetRepFix( PList );

            SetUseRepFix:
                UseRepFix := recast( PList^.Selection, OnOffType ) = On;

            SetRetry:
                DoSetRetry( PList );

            SetBreakTime:
                writeln('Send break is not implemented!');

            SetEscape:
                SetEscChar( PList^.Arg );

            otherwise:
                writeln('Bad SET alternative: ', ord( SetParm ) );
        end;
    end;

    procedure ShowOnOff( OnValue : boolean );
    begin
        if OnValue then
            write('ON')
        else
            write('OFF');
    end;

    procedure ShowStop;
    begin
        if StopBits=SyncrCmd then
            writeln( 'SYNCHRONOUS mode, no stop bits' )
        else begin
            write('Number of STOP-BITS = ');
            case StopBits of
                Stop1Cmd:   writeln('1');
                Stop1x5Cmd: writeln('1.5');
                Stop2Cmd:   writeln('2');
                otherwise:  writeln('invalid, code: ',ord(StopBits));
            end;
        end;
    end;

    procedure ShowParity;
    begin
        write( 'PARITY check/generation = ' );
        case Parity of
            NoKParity:      writeln('NONE');
            EvenKParity:    writeln('EVEN');
            OddKParity:     writeln('ODD');
            MarkKParity:    writeln('MARK (1)');
            SpaceKParity:   writeln('SPACE (0)');
            otherwise:      writeln('invalid, code: ',ord(Parity));
        end;
    end;

    procedure ShowBaud;
    begin
        write( 'BAUDrate = ' );
        case Baud of
            SP110:      write('110');
            SP150:      write('150');
            SP300:      write('300');
            SP600:      write('600');
            SP1200:     write('1200');
            SP2400:     write('2400');
            SP4800:     write('4800');
            SP9600:     write('9600');
            otherwise:  writeln('invalid, code: ',ord(Baud));
        end;
        if Baud in [SP110..SP9600] then
            writeln(' bps');
    end;

    procedure ShowFWarning;
    begin
        write( 'FILE-WARNING = ');
        ShowOnOff( FileWarning );
        writeln;
    end;

    procedure ShowDebug;
    begin
        write( 'DEBUG output = ');
        ShowOnOff( Debug );
        writeln;
    end;

    procedure ShowUse8Quote;
    begin
        write( 'USE-8-BIT-QUOTE = ');
        if Use8Quote then
            write('AUTO')
        else
            write('OFF');
        writeln;
    end;

    procedure ShowUseRepFix;
    begin
        write( 'USE-REPEAT-PREFIX = ');
        if UseRepFix then
            write('AUTO')
        else
            write('OFF');
        writeln;
    end;

    procedure ShowLog;
    begin
        write( 'LOG session to file = ' );
        ShowOnOff( FileSave );
        writeln;
    end;

    procedure ShowLFile;
    begin
        if SaveFile='' then
            writeln('No log file active')
        else
            writeln('LOG-FILE = ',SaveFile);
    end;

    procedure DisplayChar( Ch : Char );
    var Ch1 : char;
    begin
        Ch1 := Chr( LAnd( Ord( Ch ), #177 ) );
        if ch1<' ' then
            write( 'Ctrl-', Ctl( Ch1 ) )
        else
            if ord(Ch1)=177 then
                write( 'DEL' )
            else
                write('''',Ch1,'''');
        if Ch<>Ch1 then write(' (Hi bit=1)');
    end;

    procedure Show8Quote;
    begin
        write('8-BIT-QUOTE = ');
        DisplayChar( Bit8Quote );
        writeln;
    end;

    procedure ShowRepFix;
    begin
        write('REPEAT-PREFIX = ');
        DisplayChar( RepFix );
        writeln;
    end;

    procedure ShowEscChar;
    begin
        write('ESCAPE-CHARACTER = ');
        ShowKey( EscKey );
        writeln;
    end;

    procedure ShowPSize( PSize : integer );
    begin
        writeln('  max. PACKET-LENGTH = ', PSize:2 );
    end;

    procedure ShowTOut( TimeOut : integer );
    begin
        writeln('  TIME-OUT after ',TimeOut:2,' seconds');
    end;

    procedure ShowQuote( Quote : char );
    begin
        writeln('  control QUOTE = ''',Quote,'''');
    end;

    procedure ShowSOH( SOH : char );
    begin
        write('  START-OF-PACKET = ');
        DisplayChar( SOH );
        writeln;
    end;

    procedure ShowEOL( EOL : char );
    begin
        write('  END-OF-LINE = ');
        DisplayChar( EOL );
        writeln;
    end;

    procedure ShowPad( Padding : integer );
    begin
        writeln('  PADDING between packets = ', Padding:2,' characters');
    end;

    procedure ShowPChar( PadChar : char );
    begin
        write('  PADCHAR = ');
        DisplayChar( PadChar );
        writeln;
    end;

    procedure ShowSend;
    begin
        writeln( 'SEND parameters:');
        ShowPSize(  SendPSize );
        ShowTOut(   SendTimeOut );
        ShowQuote(  SendQuote );
        ShowSOH(    SendSOH );
        ShowEOL(    SendEOL );
        ShowPad(    SendNPad );
        ShowPChar(  SendPadChar );
    end;

    procedure ShowReceive;
    begin
        writeln( 'RECEIVE parameters:');
        ShowPSize(  RecPSize );
        ShowTOut(   RecTimeOut );
        ShowQuote(  RecQuote );
        ShowSOH(    RecSOH );
    end;

    procedure ShowFHeader;
    var I : integer;
    begin
        writeln( 'FILE-HEADER transformations: ');
        write(   '  NORD transformation = ');
        if Nord then begin
            writeln( '  ON');
            writeln( '   (temporary NO-TRUNCATE and CONVERT UPPER)');
        end else begin
            writeln( '  OFF');
            if NumTrunc=0 then
                writeln('  NO-TRUNCATE of file name')
            else begin
                write('  TRUNCATE file name ');
                write( TruncList[1]:1 );
                for i := 2 to NumTrunc do
                    write( ',', TruncList[I]:1 );
                writeln;
            end;
            if Translate=TransOff then
                writeln('  CONVERT OFF')
            else begin
                write('  CONVERT file name into ');
                case Translate of
                    TransUpper:
                        writeln('UPPER case');
                    TransLower:
                        writeln('LOWER case');
                    otherwise:
                        writeln('<illegal parameter value>');
                end;
            end;
        end;
    end;

    procedure ShowRetry;
    begin
        writeln( 'RETRY limits:');
        writeln( '  INITIAL-CONNECTION = ',MaxTryInit:2);
        writeln( '  PACKET             = ',MaxTryPack:2);
        writeln( '  COMMANDS           = ',MaxTryComm:2);
    end;

    procedure   ShowCommand( PList : pPListEntry );
    var SetParm : SetCommType;
    begin
        SetParm := recast( PList^.Selection, SetCommType );
        PList := PList^.NextPList;

        writeln;
        case SetParm of

            SetStop:
                ShowStop;

            SetParity:
                ShowParity;

            SetBaud:
                ShowBaud;

            SetFileWarning:
                ShowFWarning;

            SetLog:
                ShowLog;

            SetLogFile:
                ShowLFile;

            SetDebugging:
                ShowDebug;

            SetSend:
                ShowSend;

            SetReceive:
                ShowReceive;

            SetFileHeader:
                ShowFHeader;

            Set8BitQuote:
                Show8Quote;

            SetUse8BitQuote:
                ShowUse8Quote;

            SetRepFix:
                ShowRepFix;

            SetUseRepFix:
                ShowUseRepFix;

            SetRetry:
                ShowRetry;

            SetBreakTime:
                writeln('Send break is not implemented!');

            SetEscape:
                ShowEscChar;

            SetNotFound:
                begin
                    ShowStop;
                    ShowParity;
                    ShowBaud;
                    ShowFWarning;
                    ShowLog;
                    ShowLFile;
                    ShowDebug;
                    ShowSend;
                    ShowReceive;
                    ShowFHeader;
                    Show8Quote;
                    ShowUse8Quote;
                    ShowRepFix;
                    ShowUseRepFix;
                    ShowRetry;
                    ShowEscChar;
                end;

            otherwise:
                writeln('Bad SHOW alternative: ', ord( SetParm ) );
        end;
        writeln;
    end;

    procedure   StatusCommand;
    begin
    end;

    procedure   SetInitPars( var Pack : Packet );
        {    Build SendInit packet   }
    var PackLen : integer;
    begin
        with Pack do
        begin
            adjust( Data, 100 );

            data[1] := ToChar(chr(RecPSize  )); { Max. packet length I handle }
            data[2] := ToChar(chr(RecTimeOut)); { When I want to be timed out }
            data[3] := ToChar(chr(RecNPad   )); { How much padding I need     }
            data[4] := ctl   (chr(RecPadChar)); { My padding character        }
            data[5] := ToChar(chr(RecEOL)    ); { End-of-line I want          }
            data[6] :=            RecQuote    ; { control-quote char I want   }
            data[8]  := '1';                    { Only 1-char checksum        }

            if (not Use8Quote) or (Parity=NoKParity) then
                data[7] :=  'N'                 { No need to use 8-bit quote  }
            else
                data[7] :=        Bit8Quote   ; { 8-bit-quote char I want     }

            if not UseRepFix then
                data[9] :=  ' '                 { Won't use repeat prefix     }
            else
                data[9] :=        RepFix;       { Repeat prefix I want        }

            PackLen := 9;
            if Data[9]=' ' then begin
                PackLen := 8;
                if Data[8]='1' then begin
                    PackLen := 7;
                    if Data[7] in [' ','N'] then begin
                        PackLen := 6;
                    end;
                end;
            end;
            Count := ToChar ( chr( PackLen + 3 ) );
            adjust( Data, PackLen + 1 );
            ptype:= PackToCh( SInitPack );
        end;
    end;

    procedure   ReadPars ( VAR Pack : Packet );
        {  Set parameters according to Pack (Which is SendInit or
            Acknowledge packet)
            and build the corresponding Acknowledge packet }
    VAR i,PackLen       : integer;
    begin
        with Pack do
        if not ( ChToPack(Ptype) IN [SInitPack,ACKPack] ) then
        begin
            CurrState := AbortAll;
            LocalError
                ( '?Attempted to read parameters from non-send-init packet' );
        end
        else
        begin
            adjust( Data, 100 );
            PackLen := ord( UnChar( count ) ) - 3;
            for i := PackLen + 1 to MaxString do
                Data[i] := ' ';

{ Don't have to agree on the following parameters }
            if UnChar( Data[1] ) = chr(0) then
                SendPSize := 96
            else
                SendPSize := ord ( UnChar ( Data[1] ) );
            data[1] := ToChar( chr( RecPSize ) );

            SendTimeOut := ord ( UnChar ( Data[2] ) );
            data[2] := ToChar( chr(RecTimeOut)  );

{            SendNPad := ord ( UnChar ( Data[3] ) );   }
            data[3] := ToChar( chr(RecNPad) );

            if UnChar(Data[4])=chr(0) then
                SendPadChar := chr(0)
            else
                SendPadChar := Ctl ( Data[4] ) ;
            data[4] := ctl( RecPadChar );

            if UnChar(Data[5])=chr(0) then
                SendEOL   := chr(13)
            else
                SendEOL   := UnChar ( Data[5] ) ;
            data[5] := ToChar( RecEOL );

            if UnChar(Data[5])=chr(0) then
                SendQuote := '#'
            else
                SendQuote := Data[6] ;
            data[6] := RecQuote;

{ On this one, we have to agree, else there will be no 8-bit quoting }
            if not ( (Data[7] in (OkQuote + ['Y'])) and Use8Quote ) then
            begin
                    { Default, if not acceptable 8-bit quote character }
                NowUse8Quote := FALSE;
                Data[7] := 'N';   { I agree NOT to do 8-bit quoting }
            end
            else
            begin
                NowUse8Quote := TRUE;       { Only if this Kermit is sending: }
                if Data[7]<>'Y' then        { 'Y' means my request to use     }
                    Bit8Quote := Data[7];   { 8-bit quoting is accepted       }
                                            { Else: use proposed quote char   }
                Data[7] := 'Y';             { I agree to do 8-bit quoting     }
            end;

{ Checksum type :  Default is 1-character checksum }
            Data[8] := '1'; { Not supporting 2 or 3-character checksums yet }

{ Repeat prefix :  have to agree, else no repeat prefixing }
            if not ( (Data[9] in OkQuote) and UseRepFix ) then
            begin
                    { Default, if not acceptable repeat prefix }
                NowUseRepFix := FALSE;
                Data[9] := ' ';   { I won't do repeat prefixing }
            end
            else
            begin
                NowUseRepFix := TRUE;       { repeat prefix is accepted       }
                RepFix := Data[9];          { agree by returning same value   }
            end;

            if (Bit8Quote=SendQuote) and NowUse8Quote then begin
                LocalError('?Cant send same 8-bit quote and control quote');
                LocalError(' Denies 8-bit quoting!' );
                Data[7] := ' ';
                NowUse8Quote := false;
            end;
            if (RepFix=SendQuote) and NowUseRepFix then begin
                LocalError('?Cant send same repeat prefix and control quote');
                LocalError(' Denies repeat prefixing!');
                Data[9] := ' ';
                NowUseRepFix := false;
            end;
            if (RepFix=Bit8Quote) and NowUseRepFix and NowUse8Quote then
            begin
                LocalError('?Cant send same repeat prefix and 8-bit quote');
                LocalError(' Denies repeat prefixing!');
                Data[9] := ' ';
                NowUseRepFix := false;
            end;

            PackLen := 9;
            if Data[9]=' ' then begin
                PackLen := 8;
                if Data[8]='1' then begin
                    PackLen := 7;
                    if Data[7] in [' ','N'] then begin
                        PackLen := 6;
                    end;
                end;
            end;
            Count := ToChar ( chr( PackLen + 3 ) );
            adjust( Data, PackLen + 1 );
            Ptype := PackToCh ( ACKPack );
        end;
    end;


    procedure InitParameters;
    {  Abstract:
        This procedure initializes various global Kermit variables:
        "Constants", Transmission parameters, Kermit state variables.
        NB!  This procedure is to be called only ONCE during the run!  }

    begin

        SaveFile := '';

        LegalPackets    :=  ['D','Y','N','S','B','F','Z','E','R','C','G','X'];

{ What I expect he will want }

        SendSOH         :=  chr(1);
        SendPSize       :=  94;         { - max. packet size           }
        SendTimeOut     :=  5;          { - 5 seconds timeout          }
        SendNPad        :=  0;          { - no padding                 }
        SendPadChar     :=  chr(0);     { - ASCII NUL as padchar       }
        SendEOL         :=  chr(13);    { - carriage return as eol     }
        SendQuote       :=  '#';        { - sharp as control quote     }

{ What I want from him (parameters which will be used when I send-initiate) }

        RecSOH          :=  chr(1);
        RecPSize        :=  59;         { for a Perq with standard buffersize }
        RecTimeOut      :=  5;          { time-out I want               }
        RecNPad         :=  0;          { Need no padding               }
        RecPadChar      :=  chr(0);
        RecEOL          :=  chr(13);    { Standard End-Of-Line          }
        RecQuote        :=  '#';        { Standard control quote        }

{ What to do about 8-bit quoting }
        Use8Quote       :=  FALSE;      {  8-bit quoting disabled       }
        NowUse8Quote    :=  Use8Quote;
        Bit8Quote       :=  '&';

        UseRepFix       :=  FALSE;      {  Repeat prefixing disable     }
        NowUseRepFix    :=  UseRepFix;
        RepFix          :=  '~';

        LongWait        :=    4;        { Multiplication factor for TimeOut }
                     { during SendFileHeader (to allow for opening file) }

        LocalKermit     :=  FALSE;      { This frog is born a remote kermit }
        DisableTimOut   :=  FALSE;      { Allow partner to enable timeout }
        FileWarning     :=  TRUE;       { Do not write over existing files }
        FileSave        :=  FALSE;
        Debug           :=  FALSE;

        Nord            :=  FALSE;      { Not NORD transformation }
        TruncList[1]    :=  8;
        TruncList[2]    :=  3;
        NumTrunc        :=  2;          { Truncate file name 8+3 }
        OldTrunc        :=  NumTrunc;
        Translate       :=  TransUpper; { Translate file names to upper case }

        CurrState       :=  Complete;   { Avoid starting out in a bad state }
        N               :=  0;          { Start out with packet zero }
        NumTry          :=  0;
        OldTry          :=  0;

        MaxTryInit      :=  8;          { Retries before giving up }
        MaxTryPack      :=  5;
        MaxTryComm      :=  3;

        EscKey          :=  chr( ord(']')+128 );       { Control - ] }

{ Then some useful character sets :  NB! they are recomputed by ReadPars }
            {  This is the set which the set of control characters is mapped
                into by the Ctl function }
        CtlMapping :=  [ ctl( chr(  0) )..ctl( chr(    31) ), ctl( chr(127) ),
                         ctl( chr(128) )..ctl( chr(31+128) ), ctl( chr(255) )];
            {  Valid quote characters, i.e all printable characters
                which Ctl does not map a control character into }
        OkQuote     :=  ['!'..'~'] - CtlMapping;

        Quotes      :=  [RecQuote, Bit8Quote, RepFix];

    end;

{=============================================================================}

procedure CleanupParameters;
begin
    SetSaveFile( '' );  { force close of previous SaveFile }
end.