home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / pibterm / pibt41s1.arc / EXECUTC1.MOD < prev    next >
Text File  |  1988-03-07  |  48KB  |  1,289 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           Execute_Command --- Execute PibTerm  command               *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Execute_Command( VAR Command    : Pibterm_Command_Type;
  6.                            VAR Done       : BOOLEAN;
  7.                                Use_Script : BOOLEAN );
  8.  
  9. (*----------------------------------------------------------------------*)
  10. (*                                                                      *)
  11. (*     Procedure:  Execute_Command                                      *)
  12. (*                                                                      *)
  13. (*     Purpose:    Execute PibTerm Commands                             *)
  14. (*                                                                      *)
  15. (*     Calling Sequence:                                                *)
  16. (*                                                                      *)
  17. (*        Execute_Command( VAR Command    : Pibterm_Command_Type;       *)
  18. (*                         VAR Done       : BOOLEAN;                    *)
  19. (*                             Use_Script : BOOLEAN );                  *)
  20. (*                                                                      *)
  21. (*           Command    --- Command to execute                          *)
  22. (*           Done       --- set TRUE if termination command found       *)
  23. (*           Use_Script --- TRUE if this is a script command execution  *)
  24. (*                                                                      *)
  25. (*      Calls:   Async_Send_String                                      *)
  26. (*               PibDialer                                              *)
  27. (*               Async_Send_Break                                       *)
  28. (*               Async_Carrier_Detect                                   *)
  29. (*               Display_Commands                                       *)
  30. (*               Delay                                                  *)
  31. (*               GetAreaCode                                            *)
  32. (*               PibUpLoad                                              *)
  33. (*               PibDownLoad                                            *)
  34. (*               Save_Screen                                            *)
  35. (*               Restore_Screen                                         *)
  36. (*               Draw_Menu_Frame                                        *)
  37. (*               Fast_Change_Params                                     *)
  38. (*               PibFileManipulation                                    *)
  39. (*               Get_Capture_File                                       *)
  40. (*               Toggle_Option                                          *)
  41. (*               HangUpPhone                                            *)
  42. (*               Send_Function_Key                                      *)
  43. (*               Set_Input_Keys                                         *)
  44. (*               Set_Translate_Table                                    *)
  45. (*               Do_Screen_Dump                                         *)
  46. (*               DosJump                                                *)
  47. (*               Handle_Function_Key                                    *)
  48. (*                                                                      *)
  49. (*----------------------------------------------------------------------*)
  50.  
  51. VAR
  52.    Flag       : BOOLEAN;
  53.    I          : INTEGER;
  54.    J          : INTEGER;
  55.    LongI      : LONGINT;
  56.    LongJ      : LONGINT;
  57.    T_Type     : Terminal_Type;
  58.    TimeW      : STRING[8];
  59.    TimeN      : STRING[8];
  60.    TimeO      : STRING[8];
  61.    Local_Save : Saved_Screen_Ptr;
  62.    ESC_Found  : BOOLEAN;
  63.    Trans_Type : Transfer_Type;
  64.    Ch         : CHAR;
  65.    Rem_Ch     : CHAR;
  66.    XPos       : INTEGER;
  67.    GotChar    : BOOLEAN;
  68.    S          : AnyStr;
  69.    Echo       : BOOLEAN;
  70.    Test_Cond  : BOOLEAN;
  71.    File_Done  : BOOLEAN;
  72.    Do_Editing : BOOLEAN;
  73.    Do_Viewing : BOOLEAN;
  74.    F          : FILE;
  75.    Alter_Status : BOOLEAN;
  76.    Drive_Word   : WORD;
  77.    Free_Size    : LONGINT;
  78.    Search_Attr  : BYTE;
  79.    Ansi_Term    : BOOLEAN;
  80.    Com_Line_Scr : BOOLEAN;
  81.  
  82. VAR
  83.    Save_Do_Status_Line : BOOLEAN;
  84.  
  85. (* STRUCTURED *) CONST
  86.    Oper_Type_Vector : ARRAY[0..MaxOperandTypes] OF OperandType =
  87.                       ( Bad_Operand_Type, Operator_Type, Integer_Variable_Type,
  88.                         Real_Variable_Type, String_Variable_Type,
  89.                         Char_Variable_Type,
  90.                         Integer_Constant_Type, Real_Constant_Type,
  91.                         String_Constant_Type,
  92.                         Char_Constant_Type,
  93.                         StackEnd_Type, Left_Paren_Type, Right_Paren_Type,
  94.                         Comma_Type );
  95.  
  96. (*----------------------------------------------------------------------*)
  97. (*           Remote_Input --- get remote input in response to prompt    *)
  98. (*----------------------------------------------------------------------*)
  99.  
  100. PROCEDURE Remote_Input;
  101.  
  102. (*----------------------------------------------------------------------*)
  103. (*                                                                      *)
  104. (*     Procedure:  Remote_Input                                         *)
  105. (*                                                                      *)
  106. (*     Purpose:    Gets remote input (from host system) in response to  *)
  107. (*                 prompt.                                              *)
  108. (*                                                                      *)
  109. (*     Calling Sequence:                                                *)
  110. (*                                                                      *)
  111. (*        Remote_Input;                                                 *)
  112. (*                                                                      *)
  113. (*           Global string  -Script_Remote_Reply- get the resultant     *)
  114. (*           input.                                                     *)
  115. (*                                                                      *)
  116. (*      Calls:   Async_Send                                             *)
  117. (*               Send_Function_Key                                      *)
  118. (*               Async_Receive                                          *)
  119. (*                                                                      *)
  120. (*----------------------------------------------------------------------*)
  121.  
  122. VAR
  123.    Rem_Ch     : CHAR;
  124.    XPos       : INTEGER;
  125.    GotChar    : BOOLEAN;
  126.    S          : AnyStr;
  127.    Echo       : BOOLEAN;
  128.    Ch         : CHAR;
  129.  
  130. BEGIN (* Remote_Input *)
  131.                                    (* Send prompt to remote system *)
  132.  
  133.    IF LENGTH( Script_String ) > 0 THEN
  134.       Send_Function_Key( Read_Ctrls( Script_String ) );
  135.  
  136.    Ch                     := CHR( 0 );
  137.    Script_Remote_Reply[0] := CHR( 0 );
  138.    XPos                   := WhereX;
  139.    Echo                   := ( Script_Integer_1 > 0 );
  140.  
  141.                                    (* Get response string        *)
  142.    REPEAT
  143.  
  144.       GotChar := FALSE;
  145.                                    (* Check for keyboard input   *)
  146.       IF PibTerm_KeyPressed THEN
  147.          BEGIN
  148.             Read_Kbd( Ch );
  149.             GotChar := TRUE;
  150.          END;
  151.                                    (* Check for remote input *)
  152.  
  153.       IF Async_Receive( Rem_Ch ) THEN
  154.          BEGIN
  155.             Ch      := Rem_Ch;
  156.             GotChar := TRUE;
  157.          END;
  158.                                    (* Process received character *)
  159.       IF GotChar THEN
  160.          IF Ch <> CHR( CR ) THEN
  161.             IF Ch = ^H THEN
  162.                BEGIN  (* Backspace *)
  163.                   IF WhereX > Xpos THEN
  164.                      BEGIN
  165.                         Async_Send( Ch  );
  166.                         WRITE( Ch );
  167.                         Async_Send( ' ' );
  168.                         WRITE( ' ' );
  169.                         Async_Send( Ch  );
  170.                         WRITE( Ch );
  171.                         IF ( LENGTH( Script_Remote_Reply ) > 1 ) THEN
  172.                            Script_Remote_Reply := COPY( Script_Remote_Reply,
  173.                                                   1,
  174.                                                   LENGTH( Script_Remote_Reply ) - 1 )
  175.                         ELSE
  176.                            Script_Remote_Reply[0] := CHR( 0 );
  177.                      END;
  178.                END   (* Backspace *)
  179.             ELSE
  180.                BEGIN
  181.                   Script_Remote_Reply := Script_Remote_Reply + Ch;
  182.                   IF Echo THEN
  183.                      BEGIN
  184.                         Async_Send( Ch );
  185.                         WRITE( Ch );
  186.                      END
  187.                   ELSE
  188.                      BEGIN
  189.                         Async_Send( '.' );
  190.                         WRITE( '.' );
  191.                      END
  192.                END;
  193.  
  194.    UNTIL ( Ch = CHR( CR ) ) OR ( NOT Async_Carrier_Detect );
  195.  
  196.    Script_Remote_Reply_Ok := FALSE;
  197.  
  198.                                    (* Copy to variable if necessary *)
  199.  
  200.    IF ( Script_Integer_2 > 2 ) THEN
  201.       Script_Variables^[Script_Integer_2].Var_Value^ :=
  202.          Script_Remote_Reply;
  203.  
  204. END   (* Remote_Input *);
  205.  
  206. (*----------------------------------------------------------------------*)
  207. (*           Execute_Stack --- Execute postfix command stack            *)
  208. (*----------------------------------------------------------------------*)
  209.  
  210. PROCEDURE Execute_Stack( Result_Index : INTEGER );
  211.  
  212. VAR
  213.    Stack         : ARRAY[1..MaxExecStack] OF Stack_Entry_Ptr;
  214.    End_Of_Stack  : BOOLEAN;
  215.    Stack_Index   : INTEGER;
  216.    Operand_Type  : INTEGER;
  217.    Index         : INTEGER;
  218.    LIndex        : LONGINT;
  219.    Var_Ptr       : Stack_Entry_Ptr;
  220.    IVal          : LONGINT;
  221.    Int1          : LONGINT;
  222.    Str1          : AnyStr;
  223.    Int1_Bytes    : ARRAY[1..4] OF BYTE ABSOLUTE Int1;
  224.  
  225. (*----------------------------------------------------------------------*)
  226. (*     Move_Variable_To_Stack --- Place variable on evaluation stack    *)
  227. (*----------------------------------------------------------------------*)
  228.  
  229. PROCEDURE Move_Variable_To_Stack( Index : INTEGER );
  230.  
  231. VAR
  232.    IType : OperandType;
  233.  
  234. BEGIN (* Move_Variable_To_Stack *)
  235.  
  236.    INC( Stack_Index );
  237.  
  238.    NEW( Stack[Stack_Index] );
  239.                                    (* Defines a script record *)
  240.  
  241.    IType                      := Script_Variables^[Index].Var_Type;
  242.    Stack[Stack_Index]^.TypVal := IType;
  243.  
  244.    CASE IType OF
  245.       Integer_Variable_Type: MOVE( Script_Variables^[Index].Var_Value^[1],
  246.                                    Stack[Stack_Index]^.IntVal,
  247.                                    SIZEOF( LongInt ) );
  248.       String_Variable_Type : Stack[Stack_Index]^.StrVal := Script_Variables^[Index].Var_Value^;
  249.    END (* CASE *);
  250.  
  251. END   (* Move_Variable_To_Stack *);
  252.  
  253. (*----------------------------------------------------------------------*)
  254. (* Move_Integer_Constant_To_Stack --- Place integer on evaluation stack *)
  255. (*----------------------------------------------------------------------*)
  256.  
  257. PROCEDURE Move_Integer_Constant_To_Stack( IntVal : LONGINT );
  258.  
  259. BEGIN (* Move_Integer_Constant_To_Stack *)
  260.  
  261.    INC( Stack_Index );
  262.  
  263.    NEW( Stack[Stack_Index] );
  264.  
  265.    Stack[Stack_Index]^.TypVal := Integer_Variable_Type;
  266.    Stack[Stack_Index]^.IntVal := IntVal;
  267.  
  268. END   (* Move_Integer_Constant_To_Stack *);
  269.  
  270. (*----------------------------------------------------------------------*)
  271. (* Move_String_Constant_To_Stack --- Place string on evaluation stack   *)
  272. (*----------------------------------------------------------------------*)
  273.  
  274. PROCEDURE Move_String_Constant_To_Stack( VAR Index : INTEGER );
  275.  
  276. VAR
  277.    L : INTEGER;
  278.  
  279. BEGIN (* Move_String_Constant_To_Stack *)
  280.  
  281.    INC( Stack_Index );
  282.  
  283.    NEW( Stack[Stack_Index] );
  284.  
  285.    L := Script_Buffer^[Index];
  286.  
  287.    MOVE( Script_Buffer^[Index+1], Stack[Stack_Index]^.StrVal[1], L );
  288.  
  289.    Stack[Stack_Index]^.StrVal[0] := CHR( L );
  290.    Stack[Stack_Index]^.TypVal    := String_Variable_Type;
  291.  
  292.    Index := Index + L;
  293. {
  294. IF Debug_Mode THEN
  295.    Debug_Write('===> Moving <' + Stack[Stack_Index]^.StrVal + '> onto stack.');
  296. }
  297. END   (* Move_String_Constant_To_Stack *);
  298.  
  299. (*----------------------------------------------------------------------*)
  300. (*       Pop_Stack_Integer --- Remove integer from evaluation stack     *)
  301. (*----------------------------------------------------------------------*)
  302.  
  303. PROCEDURE Pop_Stack_Integer( VAR IntVal : LONGINT );
  304.  
  305. BEGIN (* Pop_Stack_Integer *)
  306.  
  307.    IntVal := Stack[Stack_Index]^.IntVal;
  308.  
  309.    DISPOSE( Stack[Stack_Index] );
  310.  
  311.    DEC( Stack_Index );
  312.  
  313. END   (* Pop_Stack_Integer *);
  314.  
  315. (*----------------------------------------------------------------------*)
  316. (*       Pop_Stack_String --- Remove string from evaluation stack       *)
  317. (*----------------------------------------------------------------------*)
  318.  
  319. PROCEDURE Pop_Stack_String( VAR StrVal : AnyStr );
  320.  
  321. BEGIN (* Pop_Stack_String *)
  322.  
  323.    StrVal := Stack[Stack_Index]^.StrVal;
  324.  
  325.    DISPOSE( Stack[Stack_Index] );
  326.  
  327.    DEC( Stack_Index );
  328.  
  329. END   (* Pop_Stack_String *);
  330.  
  331. (*----------------------------------------------------------------------*)
  332. (*       Perform_Operator --- Execute operator using evaluation stack   *)
  333. (*----------------------------------------------------------------------*)
  334.  
  335. PROCEDURE Perform_Operator( Operator : OperType );
  336.  
  337. VAR
  338.    Int1: LONGINT;
  339.    Int2: LONGINT;
  340.    Str1: AnyStr;
  341.    Str2: AnyStr;
  342.    Str3: AnyStr;
  343.    IRes: LONGINT;
  344.    SRes: AnyStr;
  345.    I   : INTEGER;
  346.    I1  : INTEGER;
  347.  
  348.    Int1_Bytes : ARRAY[1..4] OF BYTE ABSOLUTE Int1;
  349.  
  350. TYPE
  351.    ArgType = ( One_String, One_Integer, Two_Integers, Two_Strings,
  352.                String_And_One_Integer, String_And_Two_Integers,
  353.                Special_Args, No_Args );
  354.  
  355. (* STRUCTURED *) CONST
  356.    ArgTypeVector : ARRAY[OperType] OF ArgType =
  357.                    ( Special_Args, Two_Integers, Two_Integers, Two_Integers,
  358.                      Two_Integers, Two_Integers, Two_Integers, Two_Integers,
  359.                      Two_Integers, Two_Integers, Two_Integers,
  360.                      Two_Strings,  Two_Strings,  Two_Strings,
  361.                      Two_Strings,  Two_Strings,  Two_Strings,
  362.                      Two_Integers,
  363.                      One_Integer,  Two_Integers, Two_Integers,
  364.                      String_And_Two_Integers, Two_Strings, One_String,
  365.                      Two_Strings, No_Args, No_Args, One_Integer,
  366.                      One_String, No_Args, One_String , One_Integer ,
  367.                      No_Args, String_And_One_Integer, One_String, One_String,
  368.                      No_Args, One_Integer, No_Args, No_Args, One_String,
  369.                      No_Args, No_Args, One_Integer, String_And_One_Integer,
  370.                      One_Integer, One_String, One_String, No_Args,
  371.                      One_String );
  372.  
  373.    ResTypeVector : ARRAY[OperType] OF OperandType =
  374.                    ( Bad_Operand_Type,
  375.                      Integer_Variable_Type, Integer_Variable_Type,
  376.                      Integer_Variable_Type, Integer_Variable_Type,
  377.                      Integer_Variable_Type, Integer_Variable_Type,
  378.                      Integer_Variable_Type, Integer_Variable_Type,
  379.                      Integer_Variable_Type, Integer_Variable_Type,
  380.                      Integer_Variable_Type, Integer_Variable_Type,
  381.                      Integer_Variable_Type, Integer_Variable_Type,
  382.                      Integer_Variable_Type, Integer_Variable_Type,
  383.                      Integer_Variable_Type, Integer_Variable_Type,
  384.                      Integer_Variable_Type, Integer_Variable_Type,
  385.                      String_Variable_Type,  Integer_Variable_Type,
  386.                      Integer_Variable_Type, String_Variable_Type,
  387.                      Integer_Variable_Type, Integer_Variable_Type,
  388.                      String_Variable_Type,  Integer_Variable_Type,
  389.                      Integer_Variable_Type, Integer_Variable_Type,
  390.                      Integer_Variable_Type, Integer_Variable_Type,
  391.                      String_Variable_Type,  String_Variable_Type,
  392.                      String_Variable_Type,  Integer_Variable_Type,
  393.                      String_Variable_Type,  String_Variable_Type,
  394.                      Integer_Variable_Type, String_Variable_Type,
  395.                      String_Variable_Type,  String_Variable_Type,
  396.                      String_Variable_Type,  Integer_Variable_Type,
  397.                      String_Variable_Type,  String_Variable_Type,
  398.                      String_Variable_Type,  Integer_Variable_Type,
  399.                      String_Variable_Type );
  400.  
  401. (*----------------------------------------------------------------------*)
  402. (*    Push_Stack_Integer --- Push integer value onto evaluation stack   *)
  403. (*----------------------------------------------------------------------*)
  404.  
  405. PROCEDURE Push_Stack_Integer( IntVal : LONGINT );
  406.  
  407. BEGIN (* Push_Stack_Integer *)
  408.  
  409.    INC( Stack_Index );
  410.  
  411.    NEW( Stack[Stack_Index] );
  412.  
  413.    Stack[Stack_Index]^.TypVal := Integer_Variable_Type;
  414.  
  415.    Stack[Stack_Index]^.IntVal := IntVal;
  416.  
  417. END   (* Push_Stack_Integer *);
  418.  
  419. (*----------------------------------------------------------------------*)
  420. (*    Push_Stack_String --- Push string value onto evaluation stack     *)
  421. (*----------------------------------------------------------------------*)
  422.  
  423. PROCEDURE Push_Stack_String( StrVal : AnyStr );
  424.  
  425. BEGIN (* Push_Stack_String *)
  426.  
  427.    INC( Stack_Index );
  428.  
  429.    NEW( Stack[Stack_Index] );
  430.  
  431.    Stack[Stack_Index]^.TypVal := String_Variable_Type;
  432.  
  433.    Stack[Stack_Index]^.StrVal := StrVal;
  434. {
  435. IF Debug_Mode THEN
  436.    Debug_Write('===> Pushing <' + StrVal + '> onto stack.');
  437. }
  438. END   (* Push_Stack_String *);
  439.  
  440. (*----------------------------------------------------------------------*)
  441.  
  442. BEGIN (* Perform_Operator *)
  443.  
  444.    CASE ArgTypeVector[Operator] OF
  445.       One_String              :  Pop_Stack_String ( Str1 );
  446.       One_Integer             :  Pop_Stack_Integer( Int1 );
  447.       Two_Integers            :  BEGIN
  448.                                     Pop_Stack_Integer( Int2 );
  449.                                     Pop_Stack_Integer( Int1 );
  450.                                  END;
  451.       Two_Strings             :  BEGIN
  452.                                     Pop_Stack_String ( Str2 );
  453.                                     Pop_Stack_String ( Str1 );
  454.                                  END;
  455.       String_And_One_Integer  :  BEGIN
  456.                                     Pop_Stack_Integer( Int1 );
  457.                                     Pop_Stack_String ( Str1 );
  458.                                  END;
  459.       String_And_Two_Integers :  BEGIN
  460.                                     Pop_Stack_Integer( Int2 );
  461.                                     Pop_Stack_Integer( Int1 );
  462.                                     Pop_Stack_String ( Str1 );
  463.                                  END;
  464.       ELSE;
  465.    END;
  466.  
  467.    CASE Operator OF
  468.  
  469.        NoOpSy  : ;
  470.        AddSy:           IRes := Int1 + Int2;
  471.        SubtractSy:      IRes := Int1 - Int2;
  472.        MultSy:          IRes := Int1 * Int2;
  473.        DivideSy:        IF ( Int2 <> 0 ) THEN
  474.                            IRes := Int1 DIV Int2
  475.                         ELSE
  476.                            IRes := 0;
  477.        ConcatSy:        BEGIN
  478.                            IRes := ORD( Str1[0] ) + ORD( Str2[0] );
  479.                            IF ( IRes <= 255 ) THEN
  480.                               SRes := Str1 + Str2
  481.                            ELSE
  482.                               SRes := Str1 + COPY( Str2, 1, 255 - ORD( Str1[0] ) );
  483.                         END;
  484.        SubStrSy:        SRes := COPY( Str1, Int1, Int2 );
  485.        IndexSy:         IRes := POS( Str1, Str2 );
  486.        LengthSy:        IRes := LENGTH( Str1 );
  487.        EqualISy:        IRes := ORD( Int1 = Int2 );
  488.        LessEqualISy:    IRes := ORD( Int1 <= Int2 );
  489.        LessISy:         IRes := ORD( Int1 < Int2 );
  490.        GreaterISy:      IRes := ORD( Int1 > Int2 );
  491.        GreaterEqualISy: IRes := ORD( Int1 >= Int2 );
  492.        NotEqualISy    : IRes := ORD( Int1 <> Int2 );
  493.        EqualSSy:        IRes := ORD( CompareStr( Str1 , Str2 ) =  Equal    );
  494.        LessEqualSSy:    IRes := ORD( CompareStr( Str1 , Str2 ) <> Greater  );
  495.        LessSSy:         IRes := ORD( CompareStr( Str1 , Str2 ) =  Less     );
  496.        GreaterSSy:      IRes := ORD( CompareStr( Str1 , Str2 ) =  Greater  );
  497.        GreaterEqualSSy: IRes := ORD( CompareStr( Str1 , Str2 ) <> Less     );
  498.        NotEqualSSy    : IRes := ORD( CompareStr( Str1 , Str2 ) <> Equal    );
  499.        AndSy          : IRes := Int1 AND Int2;
  500.        NotSy          : IRes := NOT Int1;
  501.        OrSy           : IRes := Int1 OR Int2;
  502.        XorSy          : IRes := Int1 XOR Int2;
  503.        OrdSy          : IF ( ( Int1 > 0 ) AND ( Int1 <= LENGTH( Str1 ) ) ) THEN
  504.                            IRes := ORD( Str1[ Int1 ] )
  505.                         ELSE
  506.                            IRes := 0;
  507.        ChrSy          : IF ( ( Int1 >= 0 ) AND ( Int1 <= 255 ) ) THEN
  508.                            SRes := CHR( Int1 )
  509.                         ELSE
  510.                            SRes := '';
  511.        WaitFoundSy    : IRes := ORD( Script_Wait_Found    );
  512.        ConnectedSy    : IRes := ORD( Async_Carrier_Detect );
  513.        AttendedSy     : IRes := ORD( Attended_Mode );
  514.        DialedSy       : IF Script_Dialed THEN
  515.                            IRes := Phone_Entry_Number
  516.                         ELSE
  517.                            IRes := 0;
  518.        FileExistsSy   : BEGIN
  519.                               (*!I-*)
  520.                            ASSIGN( F , Str1 );
  521.                            RESET ( F );
  522.                               (*!I+*)
  523.                            IRes := ORD( Int24Result = 0 );
  524.                               (*!I-*)
  525.                            CLOSE ( F );
  526.                               (*!I+*)
  527.                            Int1 := Int24Result;
  528.                         END;
  529.        EofSy          : BEGIN
  530.                            IF Script_File_Used[Int1] THEN
  531.                               IRes := ORD( Script_File_List[Int1]^.EOF_Seen )
  532.                            ELSE
  533.                               IRes := 1;
  534.                         END;
  535.        StringSy       : STR( Int1 , SRes );
  536.        NumberSy       : BEGIN
  537.                            VAL( TRIM( LTRIM( Str1 ) ), IRes, I1 );
  538.                            IF ( I1 <> 0 ) THEN
  539.                               IRes := 0;
  540.                         END;
  541.        IOResultSy     : IRes := Script_IO_Error;
  542.        DuplSy         : SRes := Dupl( Str1[1], Int1 );
  543.        UpperCaseSy    : SRes := UpperCase( Str1 );
  544.        TrimSy         : SRes := Trim( Str1 );
  545.        LTrimSy        : SRes := LTrim( Str1 );
  546.        ParamCountSy   : IRes := ParamCount;
  547.        ParamStrSy     : SRes := ParamStr( Int1 );
  548.        ParamLineSy    : MOVE( MEM[PrefixSeg:$80], SRes, MEM[PrefixSeg:$80] );
  549.        DateSy         : SRes := DialDateString;
  550.        TimeSy         : SRes := TimeString( TimeOfDay , Military_Time );
  551.        DialEntrySy    : IF ( ( Int1 > 0 ) AND ( Int1 <= Dialing_Dir_Size ) ) THEN
  552.                            BEGIN
  553.                               SRes[0] := CHR( Dialing_Dir_Entry_Length );
  554.                               MOVE( Dialing_Directory^[Int1], SRes[1],
  555.                                     Dialing_Dir_Entry_Length );
  556.                            END
  557.                         ELSE
  558.                            SRes := '';
  559.        ReadCtrlSy     : SRes := Read_Ctrls ( Str1 );
  560.        WriteCtrlSy    : SRes := Write_Ctrls( Str1 );
  561.        EnhKeybdSy     : IF ( ( Mem[$40:$96] AND $10 ) <> 0 ) THEN
  562.                            IRes := 1
  563.                         ELSE
  564.                            IRes := 0;
  565.        KeyStringSy    : BEGIN
  566.                            I    := Get_Key_Index( Str1 );
  567.                            SRes := '';
  568.                            IF ( I > 0 ) THEN
  569.                               IF ( Key_Definitions[I].Def <> NIL ) THEN
  570.                                  SRes := Key_Definitions[I].Def^;
  571.                         END;
  572.        ELSE ;
  573.  
  574.    END (* CASE *);
  575.  
  576.    CASE ResTypeVector[Operator] OF
  577.       Integer_Variable_Type:  Push_Stack_Integer( IRes );
  578.       String_Variable_Type :  Push_Stack_String ( SRes );
  579.       ELSE;
  580.    END (* CASE *);
  581.  
  582. END   (* Perform_Operator *);
  583.  
  584. (*----------------------------------------------------------------------*)
  585. (*       Get_Next_Operand --- Get next operand from postfix string      *)
  586. (*----------------------------------------------------------------------*)
  587.  
  588. PROCEDURE Get_Next_Operand( VAR Operand_Type : INTEGER;
  589.                             VAR LIndex       : LONGINT  );
  590.  
  591. BEGIN (* Get_Next_Operand *)
  592.  
  593.    INC( Script_Buffer_Pos );
  594.  
  595.    Operand_Type := Script_Buffer^[Script_Buffer_Pos];
  596.  
  597.    CASE Operands[Operand_Type] OF
  598.  
  599.       Operator_Type,
  600.       Integer_Variable_Type,
  601.       String_Variable_Type:  BEGIN
  602.                                 INC( Script_Buffer_Pos );
  603.                                 LIndex := Script_Buffer^[Script_Buffer_Pos];
  604.                              END;
  605.  
  606.       Integer_Constant_Type: BEGIN
  607.                                 INC( Script_Buffer_Pos );
  608.                                 MOVE( Script_Buffer^[Script_Buffer_Pos],
  609.                                       LIndex, SIZEOF( LongInt ) );
  610.                                 INC( Script_Buffer_Pos );
  611.                              END;
  612.  
  613.       String_Constant_Type:  INC( Script_Buffer_Pos );
  614.  
  615.    END (* CASE *);
  616.  
  617. END   (* Get_Next_Operand *);
  618.  
  619. (*----------------------------------------------------------------------*)
  620.  
  621. BEGIN (* Execute_Stack *)
  622. {
  623.    IF Debug_Mode THEN
  624.       Debug_Write('+++ Entering Execute_Stack +++');
  625. }
  626.    End_Of_Stack := FALSE;
  627.    Stack_Index  := 0;
  628.  
  629.    WHILE ( NOT End_Of_Stack ) DO
  630.       BEGIN
  631.  
  632.          Get_Next_Operand( Operand_Type , LIndex );
  633.  
  634.          CASE Operands[Operand_Type] OF
  635.  
  636.             Integer_Variable_Type,
  637.             String_Variable_Type :  BEGIN
  638.                                        Index := LIndex;
  639.                                        Move_Variable_To_Stack( Index );
  640.                                     END;
  641.  
  642.             Integer_Constant_Type:  Move_Integer_Constant_To_Stack( LIndex );
  643.  
  644.             String_Constant_Type :  Move_String_Constant_To_Stack ( Script_Buffer_Pos );
  645.  
  646.             Operator_Type        :  BEGIN
  647.                                        Index := LIndex;
  648.                                        Perform_Operator( OperSyms2[Index] );
  649.                                     END;
  650.  
  651.             StackEnd_Type        :  End_Of_Stack := TRUE;
  652.  
  653.          END (* CASE *);
  654.  
  655.       END;
  656.  
  657.    WITH Script_Variables^[Result_Index] DO
  658.       BEGIN
  659.          CASE Var_Type OF
  660.             Integer_Variable_Type : BEGIN
  661.                                        Pop_Stack_Integer( Int1 );
  662.                                        MOVE( Int1,
  663.                                              Var_Value^[1],
  664.                                              SIZEOF( LongInt ) );
  665.                                     END;
  666.             String_Variable_Type  : BEGIN
  667.                                        Pop_Stack_String( Str1 );
  668.                                        Var_Value^ := Str1;
  669.                                     END;
  670.             ELSE
  671. {
  672.                IF Debug_Mode THEN
  673.                   Debug_Write('*** BOGUS RESULT MODE IN EXECUTE_STACK = ' +
  674.                               ITOS( ORD( Var_Type ) ) );
  675. }
  676.                ;
  677.          END (* CASE *);
  678.       END;
  679. {
  680.    IF Debug_Mode THEN
  681.       Debug_Write('+++ Leaving Execute_Stack +++');
  682. }
  683. END   (* Execute_Stack *);
  684.  
  685. (*----------------------------------------------------------------------*)
  686.  
  687. PROCEDURE Do_Simple_If( Condit : BOOLEAN );
  688.  
  689. BEGIN (* Do_Simple_If *)
  690.  
  691.    IF ( Script_Integer_1 = 1 ) THEN
  692.       IF Condit THEN
  693.          Script_Buffer_Pos := PRED( Script_Integer_2 )
  694.       ELSE
  695.          Script_Buffer_Pos := PRED( Script_Integer_3 )
  696.    ELSE
  697.       IF ( NOT Condit ) THEN
  698.          Script_Buffer_Pos := PRED( Script_Integer_2 )
  699.       ELSE
  700.          Script_Buffer_Pos := PRED( Script_Integer_3 );
  701.  
  702. END   (* Do_Simple_If *);
  703.  
  704. (*--------------------------------------------------------------------------*)
  705. (*      Fix_Up_File_Name --- Get file name for edit/view operation          *)
  706. (*--------------------------------------------------------------------------*)
  707.  
  708. PROCEDURE Fix_Up_File_Name(      File_Function: AnyStr;
  709.                                  Path         : AnyStr;
  710.                                  FName        : AnyStr;
  711.                             VAR  Jump_Text    : AnyStr  );
  712. VAR
  713.    IPos  : INTEGER;
  714.  
  715. BEGIN (* Fix_Up_File_Name *)
  716.                                    (* Save screen *)
  717.  
  718.    Draw_Titled_Box( Saved_Screen, 5, 10, 75, 14, File_Function + ' File');
  719.  
  720.                                    (* Get name of file to edit *)
  721.  
  722.    WRITELN('Enter name of file to ', File_Function, ':');
  723.    WRITE('>');
  724.    IF ( LENGTH( FName ) = 0 ) THEN
  725.       Read_Edited_String( FName )
  726.    ELSE
  727.       WRITE( FName );
  728.    WRITELN;
  729.                                    (* Restore screen *)
  730.  
  731.    Restore_Screen_And_Colors( Saved_Screen );
  732.  
  733.                                    (* Replace file name marker in path *)
  734.                                    (* with file name just obtained     *)
  735.  
  736.    IF ( FName <> CHR( ESC ) ) THEN
  737.       BEGIN
  738.  
  739.          Jump_Text := Path;
  740.  
  741.          IPos := POS( '%F' , Jump_Text );
  742.  
  743.          WHILE( IPos > 0 ) DO
  744.             BEGIN
  745.                DELETE( Jump_Text, IPos, 2 );
  746.                INSERT( FName, Jump_Text, IPos );
  747.                IPos := POS( '%F' , Jump_Text );
  748.             END;
  749.  
  750.       END
  751.    ELSE
  752.       Jump_Text[0] := CHR( 0 );
  753.  
  754. END    (* Fix_Up_File_Name *);
  755.  
  756. (*--------------------------------------------------------------------------*)
  757. (*           Allocate_Variable --- Allocate variable if necessary           *)
  758. (*--------------------------------------------------------------------------*)
  759.  
  760. PROCEDURE Allocate_Variable;
  761.  
  762. VAR
  763.    NBytes : INTEGER;
  764.    P      : Script_Save_Variable_Record_Ptr;
  765.  
  766. BEGIN (* Allocate_Variable *)
  767.  
  768. {
  769.    IF Debug_Mode THEN
  770.       Debug_Write('--- Allocating variable # ' + ITOS( Script_Integer_1 ) +
  771.               ' = ' + Script_String + ' of type = ' + ITOS( Script_Integer_2 ) );
  772. }
  773.                                    (* Save previous var at this offset *)
  774.                                    (* if in CALLed procedure           *)
  775.  
  776.    IF ( Script_Call_Depth > 0 ) THEN
  777.       WITH Script_Call_Stack[Script_Call_Depth] DO
  778.          BEGIN
  779.             P := Save_Vars;
  780.             NEW( Save_Vars );
  781.             Save_Vars^.Prev_Var  := P;
  782.             NEW( Save_Vars^.Save_Data );
  783.             Save_Vars^.Save_Data^ := Script_Variables^[Script_Integer_1];
  784.  
  785. {
  786.             IF Debug_Mode THEN
  787.                BEGIN
  788.                   Debug_Write('--- Saving old variable ' + IToS( Script_Integer_1 ) );
  789.                   Debug_Write('                   Name = ' +
  790.                               Script_Variables^[Script_Integer_1].Var_Name );
  791.                   Debug_Write('             Call depth = ' +
  792.                               IToS( Script_Call_Depth ) );
  793.                END;
  794. }
  795.  
  796.          END;
  797.                                    (* Allocate the variable *)
  798.  
  799.    IF ( Command = DeclareSy ) THEN
  800.       WITH Script_Variables^[Script_Integer_1] DO
  801.          BEGIN
  802.  
  803.             CASE Oper_Type_Vector[Script_Integer_2] OF
  804.                Integer_Variable_Type: NBytes := 5;
  805.                String_Variable_Type : NBytes := 256;
  806.                ELSE
  807. {
  808.                   IF Debug_Mode THEN
  809.                      Debug_Write('===> WARNING, Bogus type in allocate = ' +
  810.                                  ITOS( Script_Integer_2 ) );
  811. }
  812.                                       ;
  813.             END (* CASE *);
  814.  
  815.          GETMEM( Var_Value , NBytes );
  816.  
  817.          Var_Value^ := Script_String_2;
  818.          Var_Name   := Script_String;
  819.          Var_Type   := Oper_Type_Vector[Script_Integer_2];
  820.          Var_Passed := FALSE;
  821.  
  822.       END
  823.    ELSE IF ( Command = ImportSy ) THEN
  824.       BEGIN
  825.          INC( Script_Parameter_Got );
  826.          Script_Variables^[Script_Integer_1] :=
  827.             Prev_Script_Variables^[Script_Parameters^[Script_Parameter_Got]];
  828.          Script_Variables^[Script_Integer_1].Var_Passed := TRUE;
  829.       END
  830.    ELSE (* PImportSy *)
  831.       BEGIN
  832.          INC( Proc_Parameter_Got );
  833.          Script_Variables^[Script_Integer_1] :=
  834.             Script_Variables^[Proc_Parameters^[Proc_Parameter_Got]];
  835.          Script_Variables^[Script_Integer_1].Var_Passed := TRUE;
  836.       END;
  837.  
  838.    Script_Variable_Count := MAX( Script_Variable_Count , Script_Integer_1 );
  839.  
  840. END   (* Allocate_Variable *);
  841.  
  842. (*--------------------------------------------------------------------------*)
  843. (*                Zap_Variables --- Zap script variables                    *)
  844. (*--------------------------------------------------------------------------*)
  845.  
  846. PROCEDURE Zap_Script_Variables( First : INTEGER;  Last : INTEGER );
  847.  
  848. VAR
  849.    I: INTEGER;
  850.    P: Script_Save_Variable_Record_Ptr;
  851.    V: INTEGER;
  852.  
  853. BEGIN (* Zap_Script_Variables *)
  854.                                    (* Free up variable memory *)
  855.    FOR I := Last DOWNTO First DO
  856.       WITH Script_Variables^[I] DO
  857.          IF ( NOT Var_Passed ) THEN
  858.             CASE Var_Type OF
  859.                Integer_Variable_Type: MyFreeMem( Var_Value , 5   );
  860.                String_Variable_Type : MyFreeMem( Var_Value , 256 );
  861.                ELSE;
  862.             END;
  863.                                    (* Restore old variable pointers *)
  864.                                    (* if necessary.                 *)
  865.  
  866.    IF ( Script_Call_Depth > 0 ) THEN
  867.       WITH Script_Call_Stack[Script_Call_Depth] DO
  868.          FOR I := Last DOWNTO First DO
  869.             BEGIN
  870.                P := Save_Vars;
  871.                IF ( P <> NIL ) THEN
  872.                   BEGIN
  873.                      Script_Variables^[I] := P^.Save_Data^;
  874.                      Save_Vars            := P^.Prev_Var;
  875.                      DISPOSE( P^.Save_Data );
  876.                      DISPOSE( P );
  877. {
  878.                      IF Debug_Mode THEN
  879.                         BEGIN
  880.                            Debug_Write('Restoring variable ' + IToS( I ));
  881.                            Debug_Write('            Name = ' + Script_Variables^[I].Var_Name );
  882.                            CASE Script_Variables^[I].Var_Type OF
  883.                               Integer_Variable_Type : BEGIN
  884.                                                          Debug_Write('            Type = INTEGER' );
  885.                                                          MOVE( Script_Variables^[I].Var_Value^[1], V,
  886.                                                                SIZEOF( LONGINT ) );
  887.                                                          Debug_Write('           Value = ' + IToS( V ) );
  888.                                                       END;
  889.                               String_Variable_Type  : BEGIN
  890.                                                          Debug_Write('            Type = STRING');
  891.                                                          Debug_Write('           Value = ' +
  892.                                                                      Script_Variables^[I].Var_Value^ );
  893.                                                       END;
  894.                            END (* CASE *);
  895.                            Debug_Write('             Call depth = ' +
  896.                                        IToS( Script_Call_Depth ) );
  897.                         END;
  898. }
  899.                   END;
  900.             END;
  901.                                    (* Restore old variable count *)
  902.  
  903.    Script_Variable_Count := MAX( PRED( First ) , 2 );
  904. {
  905.    IF Debug_Mode THEN
  906.       Debug_Write( 'Zap:  First = ' + IToS( First ) + ', Last = ' +
  907.                    IToS( Last ) + ', Count = ' + IToS( Script_Variable_Count ) );
  908. }
  909. END   (* Zap_Script_Variables *);
  910.  
  911. (*--------------------------------------------------------------------------*)
  912. (*           Clear_Script_Variables --- Deallocate script variables         *)
  913. (*--------------------------------------------------------------------------*)
  914.  
  915. PROCEDURE Clear_Script_Variables;
  916.  
  917. VAR
  918.    I: INTEGER;
  919.    L: INTEGER;
  920.    S: AnyStr;
  921.  
  922. BEGIN (* Clear_Script_Variables *)
  923.  
  924.                                    (* Free space for variable values *)
  925.  
  926.    Zap_Script_Variables( 0 , Script_Variable_Count );
  927.  
  928.                                    (* Free space for variable pointers *)
  929.  
  930.    MyFreeMem( Script_Variables ,
  931.             ( Script_Variable_Count + 3 ) * SizeOf( Script_Variables^[1] ) );
  932.  
  933.                                    (* No script variables active *)
  934.    Script_Variable_Count  := 2;
  935.    Script_Parameter_Count := 0;
  936.    Script_Parameter_Got   := 0;
  937.                                    (* Close all script files           *)
  938.  
  939.    FOR I := 1 TO MaxScriptOpenFiles DO
  940.       IF Script_File_Used[I] THEN
  941.          BEGIN
  942.             IF Script_File_List[I]^.Opened THEN
  943.                BEGIN
  944.                      (*!I-*)
  945.                   CLOSE( Script_File_List[I]^.F );
  946.                      (*!I+*)
  947.                   L := INT24Result;
  948.                END;
  949.             DISPOSE( Script_File_List[I] );
  950.             Script_File_Used[I] := FALSE;
  951.          END;
  952.                                    (* Turn off other script activities *)
  953.  
  954.    FOR I := 1 TO Script_Wait_Count DO
  955.       WITH Script_Wait_List[I] DO
  956.          BEGIN
  957.             DISPOSE( Wait_Text  );
  958.             DISPOSE( Wait_Reply );
  959.          END;
  960.  
  961.    Script_File_Name[0]   := CHR( 0 );
  962.    Script_Buffer         := NIL;
  963.    Script_Dialed         := FALSE;
  964.    Really_Wait_String    := FALSE;
  965.    WaitString_Mode       := FALSE;
  966.    Script_File_Count     := 0;
  967.    Script_Wait_Count     := 0;
  968.    Script_IO_Error       := 0;
  969.                                    (* Clear out command line area. *)
  970.    S := CHR( CR );
  971.    MOVE( S[0], Mem[PrefixSeg:$80], 2 );
  972.  
  973. END   (* Clear_Script_Variables *);
  974.  
  975. (*--------------------------------------------------------------------------*)
  976. (*           Read_Chars --- Read characters from script-defined file        *)
  977. (*--------------------------------------------------------------------------*)
  978.  
  979. PROCEDURE Read_Chars( VAR F        : Text_File;
  980.                       VAR S        : AnyStr;
  981.                           N        : INTEGER;
  982.                       VAR EOF_Seen : BOOLEAN;
  983.                           Use_KBD  : BOOLEAN );
  984.  
  985. VAR
  986.    I : INTEGER;
  987.    J : INTEGER;
  988.    Ch: CHAR;
  989.  
  990. BEGIN (* Read_Chars *)
  991. {
  992.    IF Debug_Mode THEN
  993.       BEGIN
  994.          Write_Log( 'N=' + CHR( ORD('0') + N ), FALSE, FALSE );
  995.          Write_Log( 'UK=' + CHR( ORD('0') + ORD(Use_KBD) ), FALSE, FALSE );
  996.       END;
  997. }
  998.    IF EOF_Seen THEN
  999.       S[0] := CHR( 0 )
  1000.    ELSE
  1001.       BEGIN
  1002.  
  1003.          I := 0;
  1004.  
  1005.          WHILE ( ( I < N ) AND ( NOT EOF_Seen ) ) DO
  1006.             BEGIN
  1007.  
  1008.                   (*!I-*)
  1009.                CASE Use_KBD OF
  1010.                   FALSE:  BEGIN
  1011.                              READ( F , Ch );
  1012.                              Script_IO_Error := INT24Result;
  1013.                              EOF_Seen        := EOF( F ) OR ( Ch = ^Z );
  1014.                           END;
  1015.                   TRUE:   BEGIN
  1016.                              Read_Kbd( Ch );
  1017.                              WRITE( Ch );
  1018.                              Script_IO_Error := INT24Result;
  1019.                           END;
  1020.                END (* CASE *);
  1021.                   (*!I+*)
  1022.  
  1023.                IF ( NOT EOF_Seen ) THEN
  1024.                   BEGIN
  1025.                      INC( I );
  1026.                      S[I] := Ch;
  1027.                   END;
  1028.  
  1029.             END;
  1030.  
  1031.          S[0] := CHR( I );
  1032.  
  1033.       END;
  1034.  
  1035. END   (* Read_Chars *);
  1036.  
  1037. (*--------------------------------------------------------------------------*)
  1038. (*           Unload_This_Script --- Unload just-executed script             *)
  1039. (*--------------------------------------------------------------------------*)
  1040.  
  1041. PROCEDURE Unload_This_Script;
  1042.  
  1043. VAR
  1044.    I: INTEGER;
  1045.    J: INTEGER;
  1046.  
  1047. BEGIN (* Unload_This_Script *)
  1048.  
  1049.    I := Current_Script_Num;
  1050.  
  1051.    MyFreeMem( Scripts[I].Script_Ptr , Scripts[I].Script_Len );
  1052.  
  1053.    FOR J := ( I + 1 ) TO Script_Count DO
  1054.       MOVE( Scripts[J], Scripts[J-1], SizeOf( Scripts[1] ) );
  1055.  
  1056.    DEC( Script_Count );
  1057.  
  1058. END   (* Unload_This_Script *);
  1059.  
  1060. (*--------------------------------------------------------------------------*)
  1061. (*           Exit_All_Scripts --- Exit all scripts regardless of nesting    *)
  1062. (*--------------------------------------------------------------------------*)
  1063.  
  1064. PROCEDURE Exit_All_Scripts;
  1065.  
  1066. VAR
  1067.    I: INTEGER;
  1068.  
  1069. BEGIN (* Exit_All_Scripts *)
  1070.  
  1071.    IF ( Script_Stack_Depth > 0 ) THEN
  1072.       REPEAT
  1073.                                    (* Free space for script buffer *)
  1074.  
  1075.          IF ( Auto_Unload_Scripts OR
  1076.               ( Scripts[Current_Script_Num].Script_Name[1] = '!' ) ) THEN
  1077.             Unload_This_Script;
  1078.  
  1079.                                    (* Free space for variable values *)
  1080.  
  1081.          Zap_Script_Variables( 0 , Script_Variable_Count );
  1082.  
  1083.                                    (* Free space for variable pointers *)
  1084.          MyFreeMem( Script_Variables ,
  1085.                   ( Script_Variable_Count + 3 ) * SizeOf( Script_Variables^[1] ) );
  1086.  
  1087.                                    (* Free space for any parameters *)
  1088.  
  1089.          IF ( Script_Parameter_Count > 0 ) THEN
  1090.             IF ( Script_Parameters <> NIL ) THEN
  1091.                DISPOSE( Script_Parameters );
  1092.  
  1093.          WITH Script_Stack_Position[Script_Stack_Depth] DO
  1094.             BEGIN
  1095.                Script_Buffer          := Buffer_Ptr;
  1096.                Script_Buffer_Pos      := Buffer_Pos;
  1097.                Current_Script_Num     := Script_Num;
  1098.                Script_Variables       := Vars_Ptr;
  1099.                Script_Variable_Count  := Vars_Count;
  1100.                Script_Parameters      := Params_Ptr;
  1101.                Script_Parameter_Count := Params_Count;
  1102.                Script_Parameter_Got   := Params_Got;
  1103.                Prev_Script_Variables  := Prev_Ptr;
  1104.             END;
  1105.  
  1106.          DEC( Script_Stack_Depth );
  1107.  
  1108.       UNTIL ( Script_Stack_Depth = 0 );
  1109.  
  1110.                                    (* Clear top-level scripts stuff *)
  1111.    Clear_Script_Variables;
  1112.                                    (* Clear command-line mode         *)
  1113.  
  1114.    Script_Command_Key_Mode := FALSE;
  1115.  
  1116.                                    (* Indicate script mode turned off *)
  1117.  
  1118.    Toggle_Option( 'Script Mode', Script_File_Mode );
  1119.  
  1120. END   (* Exit_All_Scripts *);
  1121.  
  1122. (*--------------------------------------------------------------------------*)
  1123. (*           Store_Find_Info --- Store file info for DirFind, DirNext       *)
  1124. (*--------------------------------------------------------------------------*)
  1125.  
  1126. PROCEDURE Store_Find_Info;
  1127.  
  1128. VAR
  1129.    SAttr : ShortStr;
  1130.  
  1131. BEGIN (* Store_Find_Info *)
  1132.  
  1133.    Script_IO_Error := DosError;
  1134.  
  1135.    IF ( DosError <> 0 ) THEN
  1136.       BEGIN
  1137.          Script_Variables^[Script_Integer_1].Var_Value^ := '';
  1138.          Script_Variables^[Script_Integer_2].Var_Value^ := '';
  1139.          Script_Variables^[Script_Integer_3].Var_Value^ := '';
  1140.          Script_Variables^[Script_Integer_4].Var_Value^ := '';
  1141.          Script_Variables^[Script_Integer_5].Var_Value^ := '';
  1142.       END
  1143.    ELSE
  1144.       WITH Script_Search_Rec DO
  1145.          BEGIN
  1146.  
  1147.             Script_Variables^[Script_Integer_1].Var_Value^ := Name;
  1148.             Script_Variables^[Script_Integer_2].Var_Value^ := '';
  1149.  
  1150.             SAttr := '';
  1151.  
  1152.             IF ( Attr AND ReadOnly     ) <> 0 THEN
  1153.                SAttr := 'R';
  1154.             IF ( Attr AND Hidden       ) <> 0 THEN
  1155.                SAttr := SAttr + 'H';
  1156.             IF ( Attr AND SysFile      ) <> 0 THEN
  1157.                SAttr := SAttr + 'S';
  1158.             IF ( Attr AND VolumeID     ) <> 0 THEN
  1159.                SAttr := SAttr + 'V';
  1160.             IF ( Attr AND Directory    ) <> 0 THEN
  1161.                SAttr := SAttr + 'D';
  1162.             IF ( Attr AND Archive      ) <> 0 THEN
  1163.                SAttr := SAttr + 'A';
  1164.  
  1165.             IF ( SAttr = '' ) THEN
  1166.                SAttr := 'N';
  1167.  
  1168.             Script_Variables^[Script_Integer_2].Var_Value^ := SAttr;
  1169.  
  1170.             Dir_Convert_File_Date_And_Time( Time,
  1171.                                             Script_Variables^[Script_Integer_3].Var_Value^,
  1172.                                             Script_Variables^[Script_Integer_4].Var_Value^ );
  1173.             STR( Size , Script_Variables^[Script_Integer_5].Var_Value^ );
  1174.  
  1175.          END;
  1176.  
  1177. END   (* Store_Find_Info *);
  1178.  
  1179. (*--------------------------------------------------------------------------*)
  1180. (*           Do_File_Editing --- Call file editor                           *)
  1181. (*--------------------------------------------------------------------------*)
  1182.  
  1183. PROCEDURE Do_File_Editing;
  1184.  
  1185. VAR
  1186.    S: AnyStr;
  1187.  
  1188. BEGIN (* Do_File_Editing *)
  1189.  
  1190.    IF ( LENGTH( Editor_Name ) > 0 ) THEN
  1191.       BEGIN
  1192.          IF ( POS( '%F' , Editor_Name ) > 0 ) THEN
  1193.             Fix_Up_File_Name( 'Edit', Editor_Name, Script_String, S )
  1194.          ELSE
  1195.             S := Editor_Name;
  1196.          DosJump( S );
  1197.       END
  1198.    ELSE
  1199.       PibEditor( Script_String );
  1200.  
  1201. END   (* Do_File_Editing *);
  1202.  
  1203. (*--------------------------------------------------------------------------*)
  1204. (*           Do_File_Viewing --- Call file viewer                           *)
  1205. (*--------------------------------------------------------------------------*)
  1206.  
  1207. PROCEDURE Do_File_Viewing;
  1208.  
  1209. VAR
  1210.    S: AnyStr;
  1211.  
  1212. BEGIN (* Do_File_Viewing *)
  1213.  
  1214.    IF ( LENGTH( Browser_Name ) > 0 ) THEN
  1215.       BEGIN
  1216.          IF ( POS( '%F' , Browser_Name ) > 0 ) THEN
  1217.             Fix_Up_File_Name( 'View', Browser_Name,  Script_String, S )
  1218.          ELSE
  1219.             S := Browser_Name;
  1220.          DosJump( S );
  1221.       END
  1222.    ELSE
  1223.       View_A_File( Script_String );
  1224.  
  1225. END   (* Do_File_Viewing *);
  1226.  
  1227. (*--------------------------------------------------------------------------*)
  1228. (*           CopyFile --- Copy one file to another                          *)
  1229. (*--------------------------------------------------------------------------*)
  1230.  
  1231. PROCEDURE CopyFile( F_Name : AnyStr; G_Name : AnyStr; VAR BytesDone : LONGINT );
  1232.  
  1233. VAR
  1234.    F         : FILE;
  1235.    G         : FILE;
  1236.    BytesRead : INTEGER;
  1237.  
  1238. BEGIN (* CopyFile *)
  1239.                                    (* Bytes copied    *)
  1240.    BytesDone := 0;
  1241.                                    (* Open input file *)
  1242.    ASSIGN( F , F_Name );
  1243.    RESET ( F , 1 );
  1244.  
  1245.    Script_IO_Error := Int24Result;
  1246.    IF ( Script_IO_Error <> 0 ) THEN
  1247.       EXIT;
  1248.                                    (* Open output file *)
  1249.    ASSIGN ( G , G_Name );
  1250.    REWRITE( G , 1 );
  1251.  
  1252.    Script_IO_Error := Int24Result;
  1253.    IF ( Script_IO_Error <> 0 ) THEN
  1254.       BEGIN
  1255.          CLOSE( F );
  1256.          Err := Int24Result;
  1257.          EXIT;
  1258.       END;
  1259.                                    (* Perform the copy *)
  1260.    REPEAT
  1261.  
  1262.       BlockRead( F, Sector_Data, MaxSectorLength, BytesRead );
  1263.  
  1264.       Script_IO_Error := Int24Result;
  1265.  
  1266.       IF ( ( BytesRead > 0 ) AND ( Script_IO_Error = 0 ) ) THEN
  1267.          BEGIN
  1268.             BlockWrite( G, Sector_Data, BytesRead );
  1269.             Script_IO_Error := Int24Result;
  1270.          END;
  1271.  
  1272.       BytesDone := BytesDone + BytesRead;
  1273.  
  1274.    UNTIL ( ( BytesRead < MaxSectorLength ) OR ( Script_IO_Error <> 0 ) );
  1275.  
  1276.                                    (* Close files  *)
  1277.    CLOSE( F );
  1278.    Err := Int24Result;
  1279.  
  1280.    IF ( Script_IO_Error = 0 ) THEN
  1281.       Script_IO_Error := Err;
  1282.  
  1283.    CLOSE( G );
  1284.    Err := Int24Result;
  1285.  
  1286.    IF ( Script_IO_Error = 0 ) THEN
  1287.       Script_IO_Error := Err;
  1288.  
  1289. END   (* CopyFile *);