------------------------------------------------------------------------------
--                                                                          --
--                           ASIStint COMPONENTS                            --
--                                                                          --
--                     A S I S T I N T . T E X T _ I O                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (c) 1997, Free Software Foundation, Inc.            --
--                                                                          --
-- ASIStint 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.  ASIStint  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 ASIStint; see file COPYING. --
-- If not, write to the  Free  Software  Foundation,  59 Temple Place Suite --
-- 330, Boston, MA 02111-1307, USA.                                         --
--                                                                          --
-- ASIStint  was  originally  developed  by  the  ASIS-for-GNAT team at the --
-- Software Engineering  Laboratory  of  the  Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with  the --
-- Scientific  Research  Computer  Center  of Moscow State University (SRCC --
-- MSU), Russia.                                                            --
--                                                                          --
-- This work was supported by a  grant  from  the  Swiss  National  Science --
-- Foundation, no 7SUPJ048247, funding a project entitled  "Development  of --
-- ASIS for GNAT with industry quality".                                    --
------------------------------------------------------------------------------

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

with ASIStint.Common;         use ASIStint.Common;
with ASIStint.L_Parser;       use ASIStint.L_Parser;

with File;                    use File;

with ASIStint.String_Handling;
with DeAlloc;

package body ASIStint.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 ATIPut (S: in Wide_String; Level: in 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>0 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: in Integer:= 5) is
  begin
    if Level>0 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: in Wide_String; Level: in Integer:= 5) is
  begin
    ATIPut(S, Level);
    ATINew_Line(Level);
  end;


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


  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));
    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);
    DeAlloc.Free(SP);
  end Load_Script;


  procedure OpenScript (S: in Wide_String) 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);
 
--    ASIStint.String_Handling.To_Upper(ScriptStream(Script+1).Text.All);
    if Script>0 then
      ScriptActivity(Script) := ScriptActive;
      if ScriptActive then
        ScriptStream(Script) := CurTokStream;
      end if;
    end if;

    Script := Script+1;
    ScriptActive:= True;
    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 not ScriptActivity(Script) then
        ScriptActive := False;
      else
        Dealloc.Free (CurTokStream.Text);
        CurTokStream := ScriptStream(Script);
    end if;
  end CloseScript;


  procedure OpenLog (S: in 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;

end ASIStint.Text_IO;