------------------------------------------------------------------------------
--                                                                          --
--             ASIS Tester And iNTerpreter (ASIStant) COMPONENTS            --
--                                                                          --
--                     A S I S T A N T . T E X T _ I O                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (c) 1997-2006, Free Software Foundation, Inc.         --
--                                                                          --
-- ASIStant  is  free  software;  you can  redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version.  ASIStant is  distributed  in the hope  that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;  without  even the implied warranty of MER- --
-- CHANTABILITY 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  distributed with GNAT;  see file COPYING. If --
-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- ASIStant  is an evolution of  ASIStint tool that was created by  Vasiliy --
-- Fofanov  as  part  of  a  collaboration  between  Software   Engineering --
-- Laboratory  of the  Swiss  Federal Institute of Technology in  Lausanne, --
-- Switzerland,  and the Scientific Research Computer Center of the  Moscow --
-- University, Russia,  supported by the  Swiss National Science Foundation --
-- grant #7SUPJ048247, "Development of ASIS for GNAT with industry quality" --
--                                                                          --
-- ASIStant  is  distributed as a part of the  ASIS implementation for GNAT --
-- (ASIS-for-GNAT) and is maintained by AdaCore (http://www.adacore.com).   --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;

with ASIStant.DeAlloc;        use  ASIStant.DeAlloc;
with File;                    use File;

package body ASIStant.Text_IO is

------------------------------------------------------------------------------
--  Text I/O supporting scripts and logs
------------------------------------------------------------------------------

   Session_Log : Boolean := False;
   Keybd_Log   : Boolean := False;
   SessionFD   : File_Type;
   KeybdFD     : File_Type;

   procedure Load_Script (S : Wide_String; Pos : Integer);
   --  ??? Should be documented

   procedure ATIPut (S : Wide_String; Level : Integer := 5) is
      L1, L2  : Natural;
      LF : Boolean;
   begin
      L1 := S'First; L2 := L1;
      while L2 <= S'Last loop
         L1 := L2;
         while L2 < S'Last and S (L2) /= Nul_Char loop
            L2 := L2 + 1;
         end loop;
         if S (L2) = Nul_Char then
            L2 := L2 - 1;
            LF := True;
         else
            LF := False;
         end if;

         if Level >= ConsoleOutputLevel then
            Put (S (L1 .. L2));
         end if;

         if Log and Level >= OutputLevel then
            Put (LogFD, S (L1 .. L2));
         end if;

         if not Session_Log then
            Create (SessionFD, Out_File, "session.log");
            Session_Log := True;
         end if;

         Put (SessionFD, S (L1 .. L2));

         L2 := L2 + 2;
         if LF then
            ATINew_Line (Level);
         end if;
      end loop;
   end ATIPut;

   procedure ATINew_Line (Level : Integer := 5) is
   begin
      if Level >= ConsoleOutputLevel then
         New_Line (1);
      end if;
      if Log and Level >= OutputLevel then
         New_Line (LogFD, 1);
      end if;

      New_Line (SessionFD, 1);

   end ATINew_Line;

   procedure ATIPut_Line (S : Wide_String; Level : Integer := 5) is
   begin
      ATIPut (S, Level);
      ATINew_Line (Level);
   end ATIPut_Line;

   procedure ATIPut (I : Integer; Level : Integer := 5) is
   begin
      ATIPut (Integer'Wide_Image (I), Level);
   end ATIPut;

   procedure ATIGet (S : out Wide_String; Last : out Integer) is
   begin
      Get_Line (S, Last);

      if Log then
         ATIPut_Line (S (S'First .. Last), 2);
      else
         ATIPut_Line (S (S'First .. Last), 0);
      end if;

      if not Keybd_Log then
         Create (KeybdFD, Out_File, "input.log");
         Keybd_Log := True;
      end if;

      Put_Line (KeybdFD, S (S'First .. Last));

      Last := Last + 1;
      S (Last) := Nul_Char;

   end ATIGet;

   procedure Load_Script (S : Wide_String; Pos : Integer) is
      L, Last  : Integer;
      ScriptFD : File_Type;
      SP : String_Ptr;
   begin
      L := File_Length (S);
      Open (ScriptFD, In_File, To_String (S), "wcem=8");
      Last := L + 1;
      SP := new Wide_String (1 .. Last);
      L := 1;
      while not End_Of_File (ScriptFD) loop
         Get_Line (ScriptFD, SP.all (L .. Last), L);
         SP.all (L + 1) := Nul_Char;
         L := L + 2;
      end loop;
      Close (ScriptFD);

      ScriptStream (Pos).Text := new Wide_String (1 .. L - 1);
      ScriptStream (Pos).Text.all := SP.all (1 .. L - 1);
      Free (SP);
   end Load_Script;

   procedure OpenScript (S : Wide_String; Mode : Script_Mode) is
   begin
      if Script = MAX_SCRIPTDEPTH then
         ATIPut_Line ("Maximum script depth reached.", 4);
         return;
      end if;

      ScriptStream (Script + 1) := (null, 1, 0, 0, 0);
      Load_Script (S, Script + 1);

--     ASIStant.String_Handling.To_Upper(ScriptStream(Script+1).Text.All);
      if Script > 0 then
         ScriptModes (Script) := ScriptMode;
         if ScriptMode /= INACTIVE then
            ScriptStream (Script) := CurTokStream;
         end if;
      end if;

      Script := Script + 1;
      ScriptMode := Mode;
      CurTokStream := ScriptStream (Script);

      exception
         when others =>
            ATIPut_Line ("Couldn't open script file " & S &
                        ". Check the filename.", 4);
   end OpenScript;

   procedure CloseScript is
   begin
      if Script = 0 then
         return;
      end if;
      Script := Script - 1;
      if Script = 0 or else ScriptModes (Script) = INACTIVE then
         ScriptMode := INACTIVE;
      else
         Free (CurTokStream.Text);
         CurTokStream := ScriptStream (Script);
      end if;
   end CloseScript;

   procedure OpenLog (S : Wide_String) is
   begin
      if Log then
         ATIPut_Line ("Current log closed.", 3);
         CloseLog;
      end if;
      Create (LogFD, Out_File, To_String (S));
      Log := True;
   exception
      when others =>
         ATIPut_Line ("Couldn't open log file " & S &
                      ". Check the filename.", 4);
   end OpenLog;

   procedure CloseLog is
   begin
      Close (LogFD);
      Log := False;
   end CloseLog;

end ASIStant.Text_IO;
