----------------------------------------------------------------------
--  Adadep - Main program body                                      --
--  Copyright (C) 2002 Adalog                                       --
--  Author: J-P. Rosen                                              --
--                                                                  --
--  ADALOG   is   providing   training,   consultancy,   expertise, --
--  assistance and custom developments  in Ada and related software --
--  engineering techniques.  For more info about our services:      --
--  ADALOG                   Tel: +33 1 41 24 31 40                 --
--  19-21 rue du 8 mai 1945  Fax: +33 1 41 24 07 36                 --
--  94110 ARCUEIL            E-m: info@adalog.fr                    --
--  FRANCE                   URL: http://www.adalog.fr              --
--                                                                  --
--  This  unit 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.  This  unit 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 this program; see file --
--  COPYING.   If not, write  to the  Free Software  Foundation, 59 --
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.           --
--                                                                  --
--  As  a special  exception, if  other files  instantiate generics --
--  from  this unit,  or you  link this  unit with  other  files to --
--  produce an executable,  this unit does not by  itself cause the --
--  resulting executable  to be covered  by the GNU  General Public --
--  License.  This exception does  not however invalidate any other --
--  reasons why  the executable  file might be  covered by  the GNU --
--  Public License.                                                 --
----------------------------------------------------------------------

with   -- Standard Ada units
  Ada.Characters.Handling,
  IO_Exceptions,
  Ada.Exceptions;

with   -- ASIS components
  Asis.Ada_Environments,
  Asis.Errors,
  Asis.Exceptions,
  Asis.Implementation;

with   -- Other reusable components
  Options_Analyzer;

with   -- Application specific units
  Implementation_Options,
  Units_List,
  Utilities,
  Analyzer;
procedure Adadep is
   use Implementation_Options, Utilities;
   use Asis.Implementation, Asis.Exceptions;

   Version : constant Wide_String := "1.2";

   package Options is new Options_Analyzer (Binary_Options => "bdhmrsw",
                                            Valued_Options => "op",
                                            Tail_Separator => "--");
   use Options;

   Body_Option      : Boolean;
   Spec_Option      : Boolean;
   Merge_Option     : Boolean;
   Recursive_Option : Boolean;

   procedure Analyze_Options is
      use Ada.Exceptions, Ada.Characters.Handling, Analyzer;
   begin
      if Is_Present (Option => 'h') then
         return;
      end if;

      -- Initialize options
      Utilities.Debug_Option     := Is_Present (Option => 'd');
      Utilities.Overwrite_Option := Is_Present (Option => 'w');

      Body_Option      := Is_Present (Option => 'b');
      Spec_Option      := Is_Present (Option => 's');
      Merge_Option     := Is_Present (Option => 'm');
      Recursive_Option := Is_Present (Option => 'r');

      -- Check consistency
      if Parameter_Count = 0 then
         Raise_Exception (Options_Error'Identity, "Must provide unit name");
      end if;

      -- If no -s or -b option provided, handle both
      if not (Body_Option or Spec_Option) then
         Spec_Option := True;
         Body_Option := True;
      end if;

      -- Add list of kept elements if any
      for I in 2..Parameter_Count loop
         Add_Kept_Element (To_Wide_String (Parameter (I)));
      end loop;

   end Analyze_Options;

   procedure Print_Help is
   begin
      User_Message ("Adadep V" & Version & ", (c) Adalog 2002, 2004");
      User_Message ("For information about Adalog's services, please see http://www.adalog.fr");
      User_Message ("Usage: adadep [-bdmrsw] [-o <out-file>] [-p <project-file>] " &
                    " <unit>{+|-<unit>}|@<file>" &
                    " [-- <ASIS options>]");
      User_Message ("   or: adadep -h");
   end Print_Help;

   use Ada.Characters.Handling, Analyzer;
   My_Context : Asis.Context;
begin  -- Adadep

   Analyze_Options;

   --
   -- Get rid of "help" case
   --
   if Is_Present (Option => 'h') then
      Print_Help;
      return;
   end if;

   --
   -- Initialize environment
   --
   Asis.Implementation.Initialize (Initialize_String);

   begin
      Asis.Ada_Environments.Associate (My_Context,
                                       "Adadep",
                                       -- The following String' qualification is needed to what looks
                                       -- like a Gnat bug. Anyway, it's harmless.
                                       Parameters_String (String'(Value (Option => 'p',
                                                                         Explicit_Required => True))) &
                                       To_Wide_String (Options.Tail_Value));
   exception
      when IO_Exceptions.Name_Error =>
         -- -p file not found
         User_Message ("Parameter file not found");
         return;
   end;

   Asis.Ada_Environments.Open (My_Context);

   --
   -- Register unit specification
   --
   Units_List.Register (To_Wide_String (Parameter (1)), Recursive_Option, My_Context);

   --
   -- Do the job
   --
   Units_List.Reset;
   while not Units_List.Is_Exhausted loop
      declare
         Unit_Name : constant Wide_String := Units_List.Current_Unit;
      begin
         if Spec_Option then
            Analyzer.Process(Unit_Name, Specification_Part, My_Context);
            if not Merge_Option then
               Analyzer.Produce_Result (Unit_Name, Specification_Part,
                                        Output_File => Value (Option => 'o'));
            end if;
         end if;

         if Body_Option then
            Analyzer.Process(Unit_Name, Body_Part, My_Context);
            if not Merge_Option then
               Analyzer.Produce_Result (Unit_Name, Body_Part,
                                        Output_File => Value (Option => 'o'));
            end if;
         end if;
      end;
      Units_List.Skip;
   end loop;

   if Merge_Option then
      Analyzer.Produce_Result(Output_File => Value (Option => 'o'));
   end if;

   --
   -- Clean up
   --
   Asis.Ada_Environments.Close (My_Context);
   Asis.Ada_Environments.Dissociate (My_Context);
   Asis.Implementation.Finalize;
exception
   when Occur : Options_Error =>
      User_Message (To_Wide_String (Ada.Exceptions.Exception_Message (Occur)));
      Print_Help;

   when Occur : Asis.Exceptions.ASIS_Failed =>
      case Status is
         when Asis.Errors.Use_Error =>
            User_Message ("Inconsistent tree, please remove *.adt files");
         when others =>
            Asis_Error (Occur);
      end case;

   when Occur :
     ASIS_Inappropriate_Context          |
     ASIS_Inappropriate_Container        |
     ASIS_Inappropriate_Compilation_Unit |
     ASIS_Inappropriate_Element          |
     ASIS_Inappropriate_Line             |
     ASIS_Inappropriate_Line_Number      =>
      Asis_Error (Occur);

   when Units_List.Specification_Error =>
      null;   -- Message already printed

   when Occur : others =>
      declare
         use Ada.Exceptions, Ada.Characters.Handling;
      begin
         User_Message ("Internal error: " & To_Wide_String (Exception_Name (Occur)));
         User_Message ("       Message: " & To_Wide_String (Exception_Message (Occur)));
      end;
end Adadep;
