------------------------------------------------------------------------------
--                                                                          --
--                  COMMON ASIS TOOLS COMPONENTS LIBRARY                    --
--                                                                          --
--                       A S I S _ U L . O U T P U T                        --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2004-2014, AdaCore                      --
--                                                                          --
-- Asis Utility Library (ASIS UL) 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 3, or (at your --
-- option)  any later version.  ASIS UL  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  distributed with GNAT; see file --
-- COPYING3. If not,  go to http://www.gnu.org/licenses for a complete copy --
-- of the license.                                                          --
--                                                                          --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com).               --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings.Fixed;       use Ada.Strings.Fixed;
with Ada.Text_IO;             use Ada.Text_IO;

with GNAT.OS_Lib;             use GNAT.OS_Lib;

with Asis.Extensions.Strings; use Asis.Extensions.Strings;
with Asis.Implementation;     use Asis.Implementation;

with Gnatvsn;

with ASIS_UL.Common;          use ASIS_UL.Common;
with ASIS_UL.Misc;            use ASIS_UL.Misc;
with ASIS_UL.Options;         use ASIS_UL.Options;

package body ASIS_UL.Output is

   Report_File_Name : String_Access;
   Log_File_Name    : String_Access;
   Pipe_Mode        : Boolean         := False;
   Indent_String    : constant String := "   ";
   --  Variables that set the properties of the tool report and log files

   Report_File : File_Type;
   Log_File    : File_Type;

   --------------------
   -- Close_Log_File --
   --------------------

   procedure Close_Log_File is
   begin

      if Log_Mode then
         Close (Log_File);
         Log_Mode := False;
         Free (Log_File_Name);
      end if;

   end Close_Log_File;

   -----------------------
   -- Close_Report_File --
   -----------------------

   procedure Close_Report_File is
   begin

      if not Pipe_Mode then
         Close (Report_File);
      end if;

   end Close_Report_File;

   -----------
   -- Error --
   -----------

   procedure Error (Message : String) is
   begin
      Put (Standard_Error, Tool_Name.all & ": ");

      if Log_Mode then
         Put (Log_File, Tool_Name.all & ": ");
      end if;

      Error_No_Tool_Name (Message);
   end Error;

   ------------------------
   -- Error_No_Tool_Name --
   ------------------------

   procedure Error_No_Tool_Name (Message : String) is
   begin
      Put_Line (Standard_Error, Message);

      if Log_Mode then
         Put_Line (Log_File, Message);
      end if;

   end Error_No_Tool_Name;

   -----------------------
   -- Get_Indent_String --
   -----------------------

   function Get_Indent_String return String is
   begin
      return Indent_String;
   end Get_Indent_String;

   -------------------------
   -- Get_Out_File_Format --
   -------------------------

   function Get_Out_File_Format (Val : String) return Out_File_Formats is
   begin

      if Val = "dos" or else Val = "crlf" then
         return CRLF;
      elsif Val = "unix" or else Val = "lf" then
         return LF;
      else
         Error ("Unrecognized output file format " & Val);
         raise Parameter_Error;
      end if;

   end Get_Out_File_Format;

   --------------------------
   -- Get_Report_File_Name --
   --------------------------

   function Get_Report_File_Name return String is
   begin
      return Normalize_Pathname (Report_File_Name.all);
   end Get_Report_File_Name;

   ----------
   -- Info --
   ----------

   procedure Info
     (Message  : String;
      Line_Len : Natural := 0;
      Spacing  : Natural := 0)
   is
   begin
      Info_No_EOL (Message, Line_Len, Spacing);
      New_Line (Current_Error);

      if Log_Mode then
         New_Line (Log_File);
      end if;

   end Info;

   -----------------
   -- Info_No_EOL --
   -----------------

   procedure Info_No_EOL
     (Message  : String;
      Line_Len : Natural := 0;
      Spacing  : Natural := 0)
   is
      Start_Idx   : constant Natural := Message'First;
      End_Idx     :          Natural := Message'Last;
      Start_From  :          Positive;
   begin

      if Line_Len = 0
        or else
         End_Idx - Start_Idx + 1 <= Line_Len
      then
         Put (Current_Error, Message);

         if Log_Mode then
            Put (Log_File, Message);
         end if;

      else
         --  Define which part of the Message can be placed into one line:
         while End_Idx >= Start_Idx
             and then
               not (Message (End_Idx) = ' '
                  and then
                    End_Idx - Start_Idx + 1 <= Line_Len)
         loop
            End_Idx := End_Idx - 1;
         end loop;

         if End_Idx < Start_Idx then
            --  Cannot split Message, so:
            Put (Current_Error, Message);

            if Log_Mode then
               Put (Log_File, Message);
            end if;

         else
            --  Index of the beginning of the remaining part of Message
            Start_From := End_Idx + 1;

            --  Now move End_Idx to the left to skip spaces:

            while End_Idx >= Start_Idx
                 and then
                  Message (End_Idx) = ' '
            loop
               End_Idx := End_Idx - 1;
            end loop;

            Put (Current_Error, Message (Start_Idx .. End_Idx));

            if Log_Mode then
               Put (Log_File, Message (Start_Idx .. End_Idx));
            end if;

            --  Skip spaces in the remaining part of the message, if any:
            End_Idx := Message'Last;

            while Start_From <= End_Idx
                 and then
                  Message (Start_From) = ' '
            loop
               Start_From := Start_From + 1;
            end loop;

            if Start_From <= End_Idx then
               New_Line (Current_Error);

               if Log_Mode then
                  New_Line (Log_File);
               end if;

               Info_No_EOL
                 (Message  => Spacing * ' ' & Message (Start_From .. End_Idx),
                  Line_Len => Line_Len,
                  Spacing  => Spacing);
            end if;

         end if;

      end if;

   end Info_No_EOL;

   ------------------------
   -- Print_Tool_Version --
   ------------------------

   procedure Print_Tool_Version (Released_At : Positive) is
   begin
      Put (To_Upper (Tool_Name.all));
      Put (' ');
      Put (Gnatvsn.Gnat_Version_String);
      New_Line;

      Put ("Copyright (C) ");
      Put (Image (Released_At));
      Put ('-');
      Put (Gnatvsn.Current_Year);
      Put (", ");
      Put (Gnatvsn.Copyright_Holder);
      New_Line;
      Put (Gnatvsn.Gnat_Free_Software);
      New_Line;
   end Print_Tool_Version;

   ------------------------
   -- Print_Version_Info --
   ------------------------

   procedure Print_Version_Info (Released_At : Positive) is
   begin
      Info (Tool_Name.all & ' ' & Gnatvsn.Gnat_Version_String);

      Info_No_EOL ("Copyright ");

      if Image (Released_At) /= Gnatvsn.Current_Year then
         Info_No_EOL (Image (Released_At));
         Info_No_EOL ("-");
      end if;

      Info_No_EOL (Gnatvsn.Current_Year);
      Info        (", AdaCore.");
   end Print_Version_Info;

   ------------
   -- Report --
   ------------

   procedure Report
     (Message      : String;
      Indent_Level : Natural := 0)
   is
   begin
      Report_No_EOL (Message, Indent_Level);
      Report_EOL;
   end Report;

   ----------------
   -- Report_EOL --
   ----------------

   procedure Report_EOL is
   begin

      if Pipe_Mode then
         New_Line;
      else
         New_Line (Report_File);
      end if;

   end Report_EOL;

   -------------------
   -- Report_No_EOL --
   -------------------

   procedure Report_No_EOL
     (Message      : String;
      Indent_Level : Natural := 0)
   is
   begin

      if Pipe_Mode then

         for J in 1 .. Indent_Level loop
            Put (Indent_String);
         end loop;

         Put (Message);

      else

         for J in 1 .. Indent_Level loop
            Put (Report_File, Indent_String);
         end loop;

         Put (Report_File, Message);

      end if;

   end Report_No_EOL;

   -------------------------------------
   -- Report_Unhandled_ASIS_Exception --
   -------------------------------------

   procedure Report_Unhandled_ASIS_Exception (Ex : Exception_Occurrence) is
   begin
      Error ("ASIS exception (" & Exception_Name (Ex) & ") is raised");
      Error ("ASIS Error Status is " & Asis.Implementation.Status'Img);
      Error ("ASIS Diagnosis is " & To_String (Diagnosis));

      Set_Status;
   end Report_Unhandled_ASIS_Exception;

   --------------------------------
   -- Report_Unhandled_Exception --
   --------------------------------

   procedure Report_Unhandled_Exception (Ex : Exception_Occurrence) is
   begin
      Error (Exception_Information (Ex));
   end Report_Unhandled_Exception;

   ------------------
   -- Set_Log_File --
   ------------------

   procedure Set_Log_File is
   begin

      if Log_Mode then

         if Log_File_Name = null then
            Log_File_Name :=
              new String'(Get_Global_Report_Dir & Tool_Name.all & ".log");
         end if;

         if Is_Regular_File (Log_File_Name.all) then
            Open (Log_File, Out_File, Log_File_Name.all);
         else
            Create (Log_File, Out_File, Log_File_Name.all);
         end if;

      end if;

   end Set_Log_File;

   -----------------------
   -- Set_Log_File_Name --
   -----------------------

   procedure Set_Log_File_Name (Fname : String) is
   begin
      Free (Log_File_Name);

      if Fname /= "" then
         Log_File_Name := new String'(Fname);
      end if;
   end Set_Log_File_Name;

   -------------------
   -- Set_Pipe_Mode --
   -------------------

   procedure Set_Pipe_Mode (On : Boolean := True) is
   begin
      Pipe_Mode := On;
   end Set_Pipe_Mode;

   ---------------------
   -- Set_Report_File --
   ---------------------

   procedure Set_Report_File is
   begin

      if Pipe_Mode then
         if Report_File_Name /= null then
            Error ("pipe mode and output file cannot be set together");
            raise Fatal_Error;
         end if;
      else

         if Report_File_Name = null then
            Report_File_Name :=
              new String'(Get_Global_Report_Dir & Tool_Name.all & ".out");
         end if;

         if Is_Regular_File (Report_File_Name.all) then
            Open (Report_File, Out_File, Report_File_Name.all);
         else
            Create (Report_File, Out_File, Report_File_Name.all);
         end if;

         Report_File_Name :=
           new String'(Normalize_Pathname (Report_File_Name.all));

      end if;

   exception
      when Status_Error =>
         Error ("can not open the report file, the file may be in use");
         raise Fatal_Error;
      when Fatal_Error =>
         null;
      when others =>
         Error ("can not open the report file, check the file name");
         raise Fatal_Error;
   end Set_Report_File;

   --------------------------
   -- Set_Report_File_Name --
   --------------------------

   procedure Set_Report_File_Name (Fname : String) is
   begin
      Free (Report_File_Name);

      if Fname /= "" then
         Report_File_Name := new String'(Fname);
      end if;
   end Set_Report_File_Name;

   ----------------
   -- SLOC_Error --
   ----------------

   procedure SLOC_Error
     (Message : String;
      Elem    : Asis.Element)
   is
   begin
      SLOC_Error (Message, Build_GNAT_Location (Elem));
   end SLOC_Error;

   procedure SLOC_Error
     (Message : String;
      SLOC    : String)
   is
   begin
      Put (Standard_Error, SLOC & ": ");
      if Log_Mode then
         Put (Log_File, SLOC & ": ");
      end if;

      Put (Standard_Error, Tool_Name.all & ": ");

      if Log_Mode then
         Put (Log_File, Tool_Name.all & ": ");
      end if;

      Error_No_Tool_Name (Message);
   end SLOC_Error;

   ------------------
   -- SLOC_Warning --
   ------------------

   procedure SLOC_Warning
     (Message : String;
      Elem    : Asis.Element)
   is
   begin
      if Warning_Mode /= Quiet then
         SLOC_Error (Message, Elem);
      end if;
   end SLOC_Warning;

   procedure SLOC_Warning
     (Message : String;
      SLOC    : String)
   is
   begin
      if Warning_Mode /= Quiet then
         SLOC_Error (Message, SLOC);
      end if;
   end SLOC_Warning;

   -------------
   -- Warning --
   -------------

   procedure Warning (Message : String) is
   begin

      if Warning_Mode /= Quiet then
         Error (Message);
      end if;

   end Warning;

   --------------------------
   -- Warning_No_Tool_Name --
   --------------------------

   procedure Warning_No_Tool_Name (Message : String) is
   begin

      if Warning_Mode /= Quiet then
         Error_No_Tool_Name (Message);
      end if;

   end Warning_No_Tool_Name;

end ASIS_UL.Output;