------------------------------------------------------------------------------
--                                                                          --
--                  COMMON ASIS TOOLS COMPONENTS LIBRARY                    --
--                                                                          --
--                       A S I S _ U L . O U T P U T                        --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2004-2007, 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 2, 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 --
-- COPYING. If not,  write  to the  Free Software Foundation,  51 Franklin  --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
-- 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 Asis.Implementation;     use Asis.Implementation;

with ASIS_UL.Common;          use ASIS_UL.Common;

package body ASIS_UL.Output is

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

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

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

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

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

   procedure Info
     (Message  : String;
      Line_Len : Natural := 0;
      Spacing  : Natural := 0)
   is
   begin
      Info_No_EOL (Message, Line_Len, Spacing);
      New_Line (Standard_Error);
   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 (Standard_Error, Message);
      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 (Standard_Error, Message);
         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 (Standard_Error, Message (Start_Idx .. End_Idx));

            --  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 (Standard_Error);

               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;

   -------------------------------------
   -- 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 " & 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;

end ASIS_UL.Output;
