/* @lastChanged: "1998-02-16 12:00"
 
 * @filename:   vta05
 * @purpose:    "TA_RTE_functions"
 * @release:    7.1.0.0
 * @see:        "-.-"
 *
 * @Copyright (c) 1998-2005 SAP AG"
 */
 
.tt 1 $SAP$LiveCache$VTA05$
.tt 3 $$TA_RTE_functions$1998-05-25$
 
.nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 1998-2005 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
.fo

 
.fo
***********************************************************
 
Module  : TA_RTE_functions
 
Define  :
 
        PROCEDURE
              t05build_command_fn (VAR source_fn : tsp00_VFilename;
                    VAR cmd_fn     : tsp00_VFilename;
                    VAR default_fn : tsp00_VFilename);
 
        PROCEDURE
              t05getparam (VAR is_batch  : boolean;
                    VAR is_virt_term     : boolean;
                    VAR is_prompting     : boolean;
                    VAR is_command       : boolean;
                    VAR xusertype        : tsp4_xuser;
                    VAR username         : tsp00_KnlIdentifier;
                    VAR param_password   : tsp00_Pw;
                    VAR sqluser_pw       : tsp00_CryptPw;
                    VAR serverdb         : tsp00_DbName;
                    VAR servernode       : tsp00_NodeId;
                    VAR batch_fn         : tsp00_VFilename;
                    VAR param_line       : tsp00_Line;
                    VAR color_foreground : tsp00_VtColor;
                    VAR color_bright     : tsp00_VtColor;
                    VAR color_background : tsp00_VtColor;
                    VAR color_wng_foregr : tsp00_VtColor;
                    VAR color_wng_backgr : tsp00_VtColor;
                    VAR is_ok            : boolean);
 
        PROCEDURE
              t05newline;
 
        PROCEDURE
              t05readterm (prompting_sign : char; VAR ln : tsp00_Line);
 
        PROCEDURE
              t05sqlexec (VAR term : tut_terminal;
                    VAR cmd_ln     : tsp00_Line;
                    VAR errtext    : tsp00_ErrText;
                    VAR retcode    : tsp00_Int2);
 
        PROCEDURE
              t05write_term (VAR ln : tsp00_Line);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              TA_terminal_IO : VTA09;
 
        PROCEDURE
              t09uppercase_line (VAR ln : tsp00_Line;
                    lwb : integer;
                    upb : integer);
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlarg3 (VAR user_params : tsp4_xuser_record;
                    VAR password  : tsp00_Pw;
                    VAR options   : tsp4_args_options;
                    VAR xusertype : tsp4_xuserset;
                    VAR errtext   : tsp00_ErrText;
                    VAR ok        : boolean);
 
        PROCEDURE
              sqlexec (VAR command    : tsp00_ExecLine;
                    mode              : tsp00_ExecMode;
                    VAR error         : tsp00_ExecReturn;
                    VAR errtext       : tsp00_ErrText;
                    VAR commandresult : tsp00_Int2);
 
        PROCEDURE
              sqlos (VAR os : tsp00_Os);
 
        PROCEDURE
              sqlread (VAR ln : tsp00_Line; VAR is_ok : boolean);
 
        PROCEDURE
              sqlwrite (VAR ln : tsp00_Line);
&       if $OS = UNIX
 
        PROCEDURE
              sqlthold (term_ref : tsp00_Int4;
                    manual_input : boolean);
 
        PROCEDURE
              sqltrelease (term_ref : tsp00_Int4);
&       endif
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : JuergenA
.sp
.cp 3
Created : 1985-04-29
.sp
.cp 3
Version : 2002-03-15
.sp
.cp 3
Release :      Date : 1998-05-25
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      c_manual_input = true;
      c_noterm       = 'NOTERM  ';
 
 
(*------------------------------*) 
 
PROCEDURE
      t05build_command_fn (VAR source_fn : tsp00_VFilename;
            VAR cmd_fn     : tsp00_VFilename;
            VAR default_fn : tsp00_VFilename);
 
CONST
      size_suffix = 4;
      suffix_unix = '.cmd        ';
 
VAR
      suffix_found : boolean;
      os           : tsp00_Os;
      fn_len       : integer;
      fn_pos       : integer;
      i            : integer;
      n            : tsp00_Sname;
 
BEGIN
cmd_fn     := source_fn;
for i := 1 to sizeof (default_fn) do

default_fn[i] := ' ';
sqlos (os);
(* IF  os = os_unix *)
IF  true
THEN
    (* ********* U N I X ********** *)
    BEGIN
    fn_len := sizeof (cmd_fn);
    WHILE (fn_len > 1) AND (cmd_fn [fn_len] = ' ') DO
        fn_len := fn_len - 1;
    (*ENDWHILE*) 
    suffix_found := false;
    fn_pos       := 1;
    WHILE NOT suffix_found AND (fn_pos < fn_len) DO
        IF  (cmd_fn [fn_pos] = '.') OR (cmd_fn [fn_pos] = ' ')
        THEN
            BEGIN
            suffix_found    := true;
            cmd_fn [fn_pos] := '.'
            END
        ELSE
            fn_pos := fn_pos + 1;
        (*ENDIF*) 
    (*ENDWHILE*) 
    IF  NOT suffix_found AND (fn_len + size_suffix <= sizeof (cmd_fn))
    THEN
        BEGIN
        n := suffix_unix;
        default_fn := cmd_fn;
        i := 1;
        WHILE i <= size_suffix DO
            BEGIN
            default_fn [fn_len+i] := n [i];
            i := succ(i)
            END
        (*ENDWHILE*) 
        END
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t05getparam (VAR is_batch  : boolean;
            VAR is_virt_term     : boolean;
            VAR is_prompting     : boolean;
            VAR is_command       : boolean;
            VAR xusertype        : tsp4_xuser;
            VAR username         : tsp00_KnlIdentifier;
            VAR param_password   : tsp00_Pw;
            VAR sqluser_pw       : tsp00_CryptPw;
            VAR serverdb         : tsp00_DbName;
            VAR servernode       : tsp00_NodeId;
            VAR batch_fn         : tsp00_VFilename;
            VAR param_line       : tsp00_Line;
            VAR color_foreground : tsp00_VtColor;
            VAR color_bright     : tsp00_VtColor;
            VAR color_background : tsp00_VtColor;
            VAR color_wng_foregr : tsp00_VtColor;
            VAR color_wng_backgr : tsp00_VtColor;
            VAR is_ok            : boolean);
 
CONST
      c8_version = 'VERSION ';
 
VAR
      i           : integer;
      xuserset    : tsp4_xuserset;
      c8          : tsp00_C8;
      nil_pw      : tsp00_CryptPw;
      errtext     : tsp00_ErrText;
      ln          : tsp00_Line;
      blank_line  : tsp00_Line;
      noterm_fn   : tsp00_VFilename;
      user_params : tsp4_xuser_record;
      options     : tsp4_args_options;
      blankfilename : tsp00_VFilename;
 


 
BEGIN
FOR i := 1 TO sizeof (tsp00_VFilename) DO
    blankfilename [i] := ' ';
(*ENDFOR*) 
is_batch       := false;
is_virt_term   := true;
is_prompting   := false;
is_command     := false;
xusertype      := sp4xu_sql_usermask;
xuserset       := [sp4xu_sql_usermask];
batch_fn       := blankfilename;
noterm_fn      := blankfilename;
c8             := c_noterm;
param_password := bsp_name;
i := 1;
WHILE i <= sizeof (c8) DO
    BEGIN
    noterm_fn [i] := c8 [i];
    i := succ(i)
    END;
(*ENDWHILE*) 
i := 1;
WHILE i <= sizeof (nil_pw) DO
    BEGIN
    nil_pw [i] := chr(0);
    i := succ(i)
    END;
(*ENDWHILE*) 
i := 1;
WHILE i <= sizeof (blank_line) DO
    BEGIN
    blank_line [i] := ' ';
    i := succ(i)
    END;
(*ENDWHILE*) 
param_line := blank_line;
WITH user_params DO
    BEGIN
    xu_key         := bsp_c18;
    xu_fill        := -1;
    xu_servernode  := bsp_nodeid;
    xu_serverdb    := bsp_dbname;
    xu_user        := bsp_c64;
    xu_password    := nil_pw;
    xu_sqlmode     := bsp_c8;
    xu_cachelimit  := -1;
    xu_timeout     := -1;
    xu_isolation   := -1
    END;
(*ENDWITH*) 
options.opt_component := sp4co_sql_util;
sqlarg3 (user_params, param_password, options, xuserset,
      errtext, is_ok);
IF  is_ok
THEN
    WITH user_params DO
        BEGIN
        IF  (sp4xu_sql_userdefault   in xuserset) AND
            NOT (sp4xu_sql_userparms in xuserset)
        THEN
            BEGIN
            username   := bsp_c64;
            sqluser_pw := nil_pw;
            xusertype  := sp4xu_sql_usermask
            END
        ELSE
            BEGIN
            username   := xu_user;
            sqluser_pw := xu_password;
            IF  sp4xu_sql_usermask in xuserset
            THEN
                xusertype := sp4xu_sql_usermask
            ELSE
                xusertype := sp4xu_sql_userparms
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        serverdb   := xu_serverdb;
        servernode := xu_servernode
        END;
    (*ENDWITH*) 
&ifdef TEST
(*ENDIF*) 
writeln ('userkey     : <', user_params.xu_key,  '>');
writeln ('username    : <', username,            '>');
writeln ('password    : <', param_password,      '>');
writeln ('servernode  : <', servernode,          '>');
writeln ('serverdb    : <', serverdb,            '>');
writeln ('batch_fn    : <', options.opt_runfile, '>');
writeln ('opt_param   : <', options.opt_parameter:50);
IF  xuserset = [ ]
THEN
    writeln ('xuserset    : empty')
ELSE
    BEGIN
    write ('xuserset    :');
    IF  sp4xu_sql_userdefault in xuserset
    THEN
        write (' default');
    (*ENDIF*) 
    IF  sp4xu_sql_usermask in xuserset
    THEN
        write (' mask');
    (*ENDIF*) 
    IF  sp4xu_sql_userkey in xuserset
    THEN
        write (' key');
    (*ENDIF*) 
    IF  sp4xu_sql_userparms in xuserset
    THEN
        write (' userparms');
    (*ENDIF*) 
    IF  sp4xu_sql_servernode in xuserset
    THEN
        write (' node');
    (*ENDIF*) 
    IF  sp4xu_sql_serverdb in xuserset
    THEN
        write (' db');
    (*ENDIF*) 
    IF  sp4xu_sql_params in xuserset
    THEN
        write (' params');
    (*ENDIF*) 
    writeln
    END;
(*ENDIF*) 
writeln ('comm_mode   : ', chr (ord('0') + ord(options.opt_comm_mode)));
writeln ('prompt      : ', chr (ord('0') + ord(options.opt_prompt)));
writeln ('errtext     : <', errtext, '>');
writeln ('is_ok       : ', chr (ord('0') + ord (is_ok)));
&endif
IF  NOT is_ok
THEN
    BEGIN
    i := 1;
    WHILE i <= sizeof (ln) DO
        BEGIN
        ln [i] := ' ';
        i := succ(i)
        END;
    (*ENDWHILE*) 
    ln [1] := '*';
    ln [2] := '*';
    ln [3] := '*';
    i := 1;
    WHILE i <= sizeof (errtext) DO
        BEGIN
        ln [4+i] := errtext [i];
        i := succ(i)
        END;
    (*ENDWHILE*) 
    sqlwrite (ln)
    END;
(*ENDIF*) 
IF  is_ok AND (sp4xu_sql_params in xuserset)
THEN
    BEGIN
    IF  options.opt_comm_mode = sp4cm_sql_comp_vers
    THEN
        BEGIN
        is_command   := true;
        is_virt_term := false;
        xusertype    := sp4xu_sql_userparms;
        c8           := c8_version;
        i := 1;
        WHILE i <= 8 DO
            BEGIN
            param_line [i] := c8 [i];
            i := succ(i)
            END;
        (*ENDWHILE*) 
        END
    ELSE
        BEGIN
        ta05getcolor (options.opt_parameter, color_foreground,
              color_bright, color_background, color_wng_foregr,
              color_wng_backgr);
        param_line := options.opt_parameter;
        IF  options.opt_comm_mode in [sp4cm_sql_run, sp4cm_sql_batch]
        THEN
            BEGIN
            is_batch     := (options.opt_runfile <> blankfilename)
                  AND       (options.opt_runfile <> noterm_fn    );
            is_prompting := (options.opt_prompt AND is_batch);
            IF  options.opt_runfile = noterm_fn
            THEN
                batch_fn := blankfilename
            ELSE
                batch_fn := options.opt_runfile
            (*ENDIF*) 
            END
        ELSE
            is_command := (options.opt_parameter <> blank_line);
        (*ENDIF*) 
        IF  is_command OR (options.opt_comm_mode = sp4cm_sql_batch)
        THEN
            is_virt_term := false
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END;
&ifdef TEST
(*ENDIF*) 
writeln ('xusertype   : ', chr (ord('0') + ord (xusertype       )));
writeln ('is_batch    : ', chr (ord('0') + ord (is_batch        )));
writeln ('is_virt_term: ', chr (ord('0') + ord (is_virt_term    )));
writeln ('is_promping : ', chr (ord('0') + ord (is_prompting    )));
writeln ('is_command  : ', chr (ord('0') + ord (is_command      )));
writeln ('param_ln    : <', param_line:50);
writeln ('foreground  : ', chr (ord('0') + ord (color_foreground)));
writeln ('bright      : ', chr (ord('0') + ord (color_bright    )));
writeln ('background  : ', chr (ord('0') + ord (color_background)));
writeln ('wng_foregr  : ', chr (ord('0') + ord (color_wng_foregr)));
writeln ('wng_backgr  : ', chr (ord('0') + ord (color_wng_backgr)));
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      t05newline;
 
VAR
      i  : integer;
      ln : tsp00_Line;
 
BEGIN
i := 1;
WHILE i <= sizeof (ln) DO
    BEGIN
    ln [i] := ' ';
    i := succ(i)
    END;
(*ENDWHILE*) 
sqlwrite (ln)
END;
 
(*------------------------------*) 
 
PROCEDURE
      t05readterm (prompting_sign : char; VAR ln : tsp00_Line);
 
VAR
      is_ok : boolean;
      i     : integer;
      in_ln : tsp00_Line;
 
BEGIN
i := 1;
WHILE i <= sizeof (in_ln) DO
    BEGIN
    in_ln [i] := ' ';
    i := succ(i)
    END;
(*ENDWHILE*) 
sqlread (in_ln, is_ok);
IF  is_ok
THEN
    BEGIN
    ln [1] := prompting_sign;
    i := 1;
    WHILE i <= sizeof (ln) - 1 DO
        BEGIN
        ln [1+i] := in_ln [i];
        i := succ(i)
        END;
    (*ENDWHILE*) 
    END
ELSE
    BEGIN
    i := 1;
    WHILE i <= sizeof (ln) DO
        BEGIN
        ln [i] := ' ';
        i := succ(i)
        END
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t05sqlexec (VAR term : tut_terminal;
            VAR cmd_ln     : tsp00_Line;
            VAR errtext    : tsp00_ErrText;
            VAR retcode    : tsp00_Int2);
 
CONST
      unix_async_sign  = '&';
      unix_async_token = 'async       ';
 
VAR
      os      : tsp00_Os;
      ex_err  : tsp00_ExecReturn;
      ex_mode : tsp00_ExecMode;
      pos     : integer;
      i       : integer;
      k       : integer;
      n       : tsp00_Sname;
      argln   : tsp00_ExecLine;
 
BEGIN
retcode := 0;
errtext := bsp_c40;
pos     := 1;
(* skip leading blanks *)
WHILE (pos < sizeof (cmd_ln)) AND (cmd_ln [pos] = ' ') DO
    pos := pos + 1;
(*ENDWHILE*) 
IF  cmd_ln [pos] = '!'
THEN
    pos := pos + 1
ELSE
    (* skip first token ('EXEC', 'CMS' ... *)
    WHILE (pos < sizeof (cmd_ln)) AND (cmd_ln [pos] <> ' ') DO
        pos := pos + 1;
    (*ENDWHILE*) 
(*ENDIF*) 
(* skip blanks - skip to first command token *)
WHILE (pos < sizeof (cmd_ln)) AND (cmd_ln [pos] = ' ') DO
    pos := pos + 1;
(*ENDWHILE*) 
i := 1;
WHILE i <= sizeof (argln) DO
    BEGIN
    argln [i] := ' ';
    i := succ(i)
    END;
(*ENDWHILE*) 
ex_err := ex_ok;
sqlos (os);
CASE os OF
    os_unix, os_os2, os_win32 :
        BEGIN
        IF  cmd_ln [pos] = unix_async_sign
        THEN
            BEGIN
            ex_mode := async;
            pos     := pos + 1
            END
        ELSE
            BEGIN
            k := pos;
            i := 1;
            WHILE (k < sizeof (cmd_ln)) AND (i <= sizeof (n))
                  AND (cmd_ln [k] <> ' ') DO
                BEGIN
                n [i] := cmd_ln [k];
                k     := k + 1;
                i     := i + 1
                END;
            (*ENDWHILE*) 
            IF  n = unix_async_token
            THEN
                BEGIN
                ex_mode := async;
                pos     := k
                END
            ELSE
                ex_mode := sync_new_session
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        (* skip blanks *)
        WHILE (pos < sizeof (cmd_ln)) AND (cmd_ln [pos] = ' ') DO
            pos := pos + 1;
        (*ENDWHILE*) 
        (* scanning command: *)
        i := 1;
        WHILE (i < sizeof (argln)) AND (pos < sizeof (cmd_ln)) DO
            BEGIN
            argln [i] := cmd_ln [pos];
            pos := pos + 1;
            i   := i   + 1
            END
        (*ENDWHILE*) 
        END;
    os_vms, os_windows :
        BEGIN
        ex_mode := sync_same_session;
        (* scanning command: *)
        i := 1;
        WHILE (i < sizeof (argln)) AND (pos < sizeof (cmd_ln)) DO
            BEGIN
            argln [i] := cmd_ln [pos];
            pos := pos + 1;
            i   := i   + 1
            END
        (*ENDWHILE*) 
        END;
    OTHERWISE
        BEGIN
        retcode := -9000;
        errtext := 'SYSTEM ERROR: NOT YET IMPLEMENTED       '
        END
    END;
(*ENDCASE*) 
IF  retcode = 0
THEN
    BEGIN
&   if $OS = UNIX
    IF  term.is_virt_term
    THEN
        sqltrelease (term.term_ref);
&   endif
    (*ENDIF*) 
    sqlexec (argln, ex_mode, ex_err, errtext, retcode);
&   if $OS = UNIX
    IF  term.is_virt_term
    THEN
        sqlthold (term.term_ref, c_manual_input);
&   endif
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  ex_err <> ex_ok
THEN
    BEGIN
    retcode := 1;
    errtext := bsp_c40;
    CASE ex_err OF
        ex_no_exec:
            n := 'NO EXEC     ';
        ex_no_async:
            n := 'NO ASYNC    ';
        ex_no_sync:
            n := 'NO SYNC     ';
        ex_no_sync_new:
            n := 'NO SYNC NEW ';
        ex_no_sync_same:
            n := 'NO SYNC SAME';
        OTHERWISE
            n := 'INVALID CALL'
        END;
    (*ENDCASE*) 
    i := 1;
    WHILE i <= sizeof (n) DO
        BEGIN
        errtext [i] := n [i];
        i := succ(i)
        END;
    (*ENDWHILE*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      t05write_term (VAR ln : tsp00_Line);
 
BEGIN
sqlwrite (ln)
END;
 
(*------------------------------*) 
 
PROCEDURE
      ta05getcolor (VAR param_line : tsp00_Line;
            VAR color_foreground   : tsp00_VtColor;
            VAR color_bright       : tsp00_VtColor;
            VAR color_background   : tsp00_VtColor;
            VAR color_wng_foregr   : tsp00_VtColor;
            VAR color_wng_backgr   : tsp00_VtColor);
 
CONST
      c_black    = 'BLACK       ';
      c_blue     = 'BLUE        ';
      c_green    = 'GREEN       ';
      c_cyan     = 'CYAN        ';
      c_magenta  = 'MAGENTA     ';
      c_default  = 'DEFAULT     ';
      c_red      = 'RED         ';
      c_setcolor = 'SETCOLOR    ';
      c_white    = 'WHITE       ';
      c_yellow   = 'YELLOW      ';
 
VAR
      is_ok      : boolean;
      i          : integer;
      curr_token : integer;
      pos        : integer;
      endpos     : integer;
      ln         : tsp00_Line;
      color      : ARRAY [2..6] OF tsp00_VtColor;
      n          : ARRAY [1..6] OF tsp00_Sname;
 
BEGIN
(* colors must be initialized *)
ln := param_line;
t09uppercase_line (ln, 1, sizeof (ln));
pos := 1;
curr_token := 1;
WHILE curr_token <=  6 DO
    BEGIN
    n [curr_token] := bsp_sname;
    WHILE (pos < sizeof (ln)) AND (ln [pos] = ' ') DO
        pos := pos + 1;
    (*ENDWHILE*) 
    endpos  := pos;
    i       := 1;
    WHILE (endpos < sizeof (ln)) AND (ln [endpos] <> ' ') DO
        BEGIN
        IF  i <= sizeof (n [curr_token])
        THEN
            n [curr_token] [i] := ln [endpos];
        (*ENDIF*) 
        i      := i + 1;
        endpos := endpos + 1
        END;
    (*ENDWHILE*) 
    pos := endpos;
    curr_token := succ(curr_token)
    END;
(*ENDWHILE*) 
IF  n [1] = c_setcolor
THEN
    BEGIN
    i     := 2;
    is_ok := true;
    WHILE is_ok AND (i <= 6) DO
        BEGIN
        IF  n [i] = bsp_sname
        THEN
            is_ok := false
        ELSE
            IF  n [i] = c_default
            THEN
                color [i] := vt_default_color
            ELSE
                IF  n [i] = c_white
                THEN
                    color [i] := vt_white
                ELSE
                    IF  n [i] = c_black
                    THEN
                        color [i] := vt_black
                    ELSE
                        IF  n [i] = c_red
                        THEN
                            color [i] := vt_red
                        ELSE
                            IF  n [i] = c_green
                            THEN
                                color [i] := vt_green
                            ELSE
                                IF  n [i] = c_yellow
                                THEN
                                    color [i] := vt_yellow
                                ELSE
                                    IF  n [i] = c_blue
                                    THEN
                                        color [i] := vt_blue
                                    ELSE
                                        IF  n [i] = c_magenta
                                        THEN
                                            color [i] := vt_pink
                                        ELSE
                                            IF  n [i] = c_cyan
                                            THEN
                                                color [i] :=
                                                      vt_light_blue
                                            ELSE
                                                is_ok := false;
                                            (*ENDIF*) 
                                        (*ENDIF*) 
                                    (*ENDIF*) 
                                (*ENDIF*) 
                            (*ENDIF*) 
                        (*ENDIF*) 
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        i := i + 1
        END;
    (*ENDWHILE*) 
    IF  NOT is_ok
    THEN
        n [2] := c_default
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  (n [1] = c_setcolor) AND (n [2] = c_default)
THEN
    BEGIN
    color_foreground  := vt_default_color;
    color_bright      := vt_default_color;
    color_background  := vt_default_color;
    color_wng_foregr  := vt_default_color;
    color_wng_backgr  := vt_default_color
    END
ELSE
    IF  n [1] = c_setcolor
    THEN
        BEGIN
        color_foreground  := color [2];
        color_bright      := color [3];
        color_background  := color [4];
        color_wng_foregr  := color [5];
        color_wng_backgr  := color [6]
        END;
    (*ENDIF*) 
(*ENDIF*) 
IF  n [1] = c_setcolor
THEN
    BEGIN
    i := 1;
    WHILE i <= sizeof (param_line) DO
        BEGIN
        param_line [i] := ' ';
        i := succ(i)
        END
    (*ENDWHILE*) 
    END
(*ENDIF*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        295
*-PRETTY-*  lines of code :        725        PRETTYX 3.10 
*-PRETTY-*  lines in file :        920         1997-12-10 
.PA 
