----------------------------------------------------------------------
--  Adasubst - Main program body                                    --
--  Copyright (C) 2002, 2004 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
  Utilities,
  Dictionary,
  Implementation_Options,
  Units_List,
  Dependencies,
  Preparator,
  Translator,
  Unrepresenter;
procedure Adasubst is
   use Utilities, Implementation_Options;
   use Asis, Asis.Implementation, Asis.Errors, Asis.Exceptions;

   Version : constant Wide_String := "1.3";
   Default_Line_Length : constant := 200;
   Min_Line_Length     : constant := 80;

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

   type Action_Kinds is (Help, Dependents, Prepare, Translate, Unrepresent);
   Action               : Action_Kinds;
   Body_Option          : Boolean;
   Spec_Option          : Boolean;
   Comment_Option       : Boolean;
   Recursive_Option     : Boolean;
   Unit_Specification   : Positive;
   Dictionary_Name      : Positive;
   Line_Length          : Natural;
   Which_O_Option       : Character := 'o';

   procedure Analyze_Options is
      use Ada.exceptions;
      L_Value : Integer;
   begin
      if Is_Present (Option => 'h') then
         Action := Help;
         return;
      end if;

      -- Determine Action
      Action := Translate;
      if Is_Present (Option => 'T') then
         if Is_Present (Option => 'P') or Is_Present (Option => 'D') or Is_Present (Option => 'R') then
            Raise_Exception (Options_Error'Identity, "Only one of T P D R option allowed");
         end if;
      elsif Is_Present (Option => 'P') then
         Action := Prepare;
         if Is_Present (Option => 'D') or Is_Present (Option => 'R') then
            Raise_Exception (Options_Error'Identity, "Only one of T P D R option allowed");
         end if;
      elsif Is_Present (Option => 'D') then
         Action := Dependents;
         if Is_Present (Option => 'R') then
            Raise_Exception (Options_Error'Identity, "Only one of T P D R option allowed");
         end if;
      elsif Is_Present (Option => 'R') then
         Action := Unrepresent;
      end if;

      -- Initialize options
      Utilities.Debug_Option     := Is_Present (Option => 'd');
      Utilities.Overwrite_Option := Is_Present (Option => 'w');
      Utilities.Error_Is_Out     := not (Is_Present (Option => 'o') or
                                         Is_Present (Option => 'O'));

      Body_Option      := Is_Present (Option => 'b');
      Spec_Option      := Is_Present (Option => 's');
      Comment_Option   := Is_Present (Option => 'c');
      Recursive_Option := Is_Present (Option => 'r');

      if Is_Present (Option => 'O') then
         if Is_Present (Option => 'o') then
            Raise_Exception (Options_Error'Identity, "Only one of 'o' and 'O' allowed");
         end if;
         Which_O_Option := 'O';
      end if;

      -- Action dependent checks
      case Action is
         when Help =>
            -- Impossible, there is a return on top
            raise Program_Error;

         when Dependents =>
            if Parameter_Count = 1 then
               Unit_Specification := 1;
            else
               Raise_Exception (Options_Error'Identity, "One and only one parameter required");
            end if;

            Recursive_Option := True;
            if Comment_Option or Is_Present (Option => 'l') then
               Raise_Exception (Options_Error'Identity, "Option 'c' or 'l' available only for translate");
            end if;

         when Prepare =>
            if Parameter_Count = 1 then
               Unit_Specification := 1;
            else
               Raise_Exception (Options_Error'Identity, "One and only one parameter required");
            end if;

            if Comment_Option or Is_Present (Option => 'l') then
               Raise_Exception (Options_Error'Identity, "Option 'c' or 'l' available only for translate");
            end if;

         when Unrepresent =>
            if Parameter_Count = 1 then
               Unit_Specification := 1;
            else
               Raise_Exception (Options_Error'Identity, "One and only one parameter required");
            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;

            -- No -l option : Length is bounded to the default
            -- -l option without value : Length is unbounded
            if Is_Present (Option => 'l') then
               L_Value := Value (Option => 'l', Default => 0);
               if L_Value < Min_Line_Length and L_Value /= 0 then
                  Raise_Exception (Options_Error'Identity, "Line length too small:" & Integer'Image (L_Value));
               end if;
               Line_Length := L_Value;
            else
               Line_Length := Default_Line_Length;
            end if;

         when Translate =>
            if Parameter_Count = 2 then
               Dictionary_Name    := 1;
               Unit_Specification := 2;
            else
               Raise_Exception (Options_Error'Identity, "Two and only two parameters required");
            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;

            -- No -l option : Length is bounded to the default
            -- -l option without value : Length is unbounded
            if Is_Present (Option => 'l') then
               L_Value := Value (Option => 'l', Default => 0);
               if L_Value < Min_Line_Length and L_Value /= 0 then
                  Raise_Exception (Options_Error'Identity, "Line length too small:" & Integer'Image (L_Value));
               end if;
               Line_Length := L_Value;
            else
               Line_Length := Default_Line_Length;
            end if;
      end case;
   end Analyze_Options;

   procedure Print_Help is
   begin
      User_Message ("Adasubst V" & Version & ", (c) Adalog 2002, 2004");
      User_Message ("For information about Adalog's services, please see http://www.adalog.fr");
      User_Message ("Usage: adasubst [-T] [-bcdrsw] [-oO <out-prefix>] [-p <project-file>] [-l <line-length>]");
      User_Message ("       <dictionary> <unit>{+|-<unit>}|@<file> [-- <ASIS options>]");
      User_Message ("   or: adasubst -P [-bdrsw] [-o out-file] [-p <project-file>] <unit>{+|-<unit>}" &
                    " [-- <ASIS options>]");
      User_Message ("   or: adasubst -D [-bdrsw] [-o out-file] [-p <project-file>] <unit>{+|-<unit>}" &
                    " [-- <ASIS options>]");
      User_Message ("   or: adasubst -R [-bcdrsw] [-o out-file] [-p <project-file>] <unit>{+|-<unit>}" &
                    " [-- <ASIS options>]");
     User_Message ("   or: adasubst -h");
   end Print_Help;

   use Ada.Characters.Handling;
   My_Context : Asis.Context;
begin  -- Adasubst

   Analyze_Options;

   case Action is
      when Help =>
         Print_Help;
         return;
      when Prepare | Dependents | Unrepresent =>
         null;
      when Translate =>
         Dictionary.Initialize (Parameter (Dictionary_Name));
   end case;

   --
   -- Initialize environment
   --

   Asis.Implementation.Initialize (Initialize_String);

   begin
      Ada_Environments.Associate (My_Context,
                                  "Adasubst",
                                  -- 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;

   Ada_Environments.Open (My_Context);

   Units_List.Register (To_Wide_String (Parameter (Unit_Specification)),
                        Recursive_Option,
                        My_Context);

   Units_List.Reset;
   while not Units_List.Is_Exhausted loop
      case Action is
         when Help =>
            -- Impossible, there is a return on top
            raise Program_Error;
         when Prepare =>
            Preparator.Process(Unit_Name      => Units_List.Current_Unit,
                               Output_Name    => Value (Option            => Which_O_Option,
                                                        Explicit_Required => True),
                               My_Context     => My_Context);

         when Dependents =>
            Dependencies.Process (Unit_Name   => Units_List.Current_Unit,
                                  Output_Name => Value (Option            => Which_O_Option,
                                                        Explicit_Required => True));

         when Unrepresent =>
            Unrepresenter.Process(Unit_Name           => Units_List.Current_Unit,
                                  Process_Spec        => Spec_Option,
                                  Process_Body        => Body_Option,
                                  Print_Changed_Lines => Comment_Option,
                                  Output_Prefix       => Value (Option            => Which_O_Option,
                                                                Explicit_Required => True),
                                  Line_Length         => Line_Length,
                                  Keep_Unchanged      => Which_O_Option = 'O',
                                  My_Context          => My_Context);
         when Translate =>
            Translator.Process(Unit_Name           => Units_List.Current_Unit,
                               Process_Spec        => Spec_Option,
                               Process_Body        => Body_Option,
                               Print_Changed_Lines => Comment_Option,
                               Output_Prefix       => Value (Option            => Which_O_Option,
                                                             Explicit_Required => True),
                               Line_Length         => Line_Length,
                               Keep_Unchanged      => Which_O_Option = 'O',
                               My_Context          => My_Context);
      end case;
      Units_List.Skip;
   end loop;

   --
   -- Clean up
   --

   Ada_Environments.Close (My_Context);
   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 Dictionary.Invalid_Dictionary =>
      User_Message ("Invalid dictionary");

   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 Adasubst;
