-------------------------------------------------------------------------------
--
--  This file is part of AdaBrowse.
--
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    AdaBrowse is free software; you can redistribute it and/or modify it
--    under the terms of the  GNU General Public License as published by the
--    Free Software  Foundation; either version 2, or (at your option) any
--    later version. AdaBrowse is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Calling the compiler.</DL>
--
-- <!--
-- Revision History
--
--   08-JUN-2003   TW  Initial version.
--   19-NOV-2003   TW  Added time-stamp check on the found tree file.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Text_IO;

with AD.File_Ops;
with AD.Messages;
with AD.Setup;
with AD.Text_Utilities;

with Util.Execution;
with Util.Pathes;
with Util.Strings;

package body AD.Compiler is

   package ASU renames Ada.Strings.Unbounded;

   Compile_Command  : ASU.Unbounded_String :=
     ASU.To_Unbounded_String (AD.Setup.GNAT_Name & " -c -gnatc -gnatt");

   procedure Set_Compile_Command
     (Cmd : in String)
   is
   begin
      Compile_Command := ASU.To_Unbounded_String (Cmd);
   end Set_Compile_Command;

   function Get_Compile_Command
     return String
   is
   begin
      return ASU.To_String (Compile_Command);
   end Get_Compile_Command;

   function Is_GNAT
     return Boolean
   is
      Cmd : constant String := Get_Compile_Command;
   begin
      return Util.Strings.First_Index (Cmd, AD.Setup.GNAT_Name & ' ') /= 0
             or else
             Util.Strings.First_Index (Cmd, "gnat ") /= 0;
   end Is_GNAT;

   Epoch_Set   : Boolean := False;
   Epoch_Tried : Boolean := False;
   Epoch       : AD.File_Ops.Time_Stamp;

   procedure Create_Unit
     (Name      : in     String;
      Options   : in     Ada.Strings.Unbounded.Unbounded_String;
      Tree_Dirs : in     Ada.Strings.Unbounded.Unbounded_String;
      File_Name : in out Ada.Strings.Unbounded.Unbounded_String;
      Ok        :    out Boolean)
   is

      procedure Run_Compiler
        (Source_Name : in String;
         Dirs        : in String)
      is
         Cmd : constant String :=
           Get_Compile_Command & ' ' & Dirs & ' ' &
            AD.Text_Utilities.Quote (Source_Name);
      begin
         AD.Messages.Debug ("Executing " & Cmd);
         Util.Execution.Execute (Cmd);
      end Run_Compiler;

      procedure Try_To_Find
        (Ok        :    out Boolean;
         Name      : in     String;
         Path      : in     ASU.Unbounded_String;
         File_Name :    out ASU.Unbounded_String)
      is
         Found : constant String := AD.File_Ops.Find (Name, Path);
      begin
         Ok := Found'Length > 0;
         if Ok then
            File_Name := ASU.To_Unbounded_String (Found);
         end if;
      end Try_To_Find;

   begin
      if Get_Compile_Command = "" then
         --  No compile command: it doesn't make sense to continue!
         Ok := False; return;
      end if;
      declare
         Full_Name : constant String := AD.File_Ops.Find (Name, Options);
      begin
         if Full_Name'Last < Full_Name'First then
            --  Couldn't find the file.
            Ok := False; return;
         end if;
         if Full_Name /= Name then
            AD.Messages.Warn
              ("Found """ & Util.Pathes.Name (Name) &
               """ at """ & Full_Name & '"');
         end if;
         if not Epoch_Set and then not Epoch_Tried then
            Epoch_Tried := True;
            --  Get an initial time stamp.
            declare
               F    : Ada.Text_IO.File_Type;
               Name : ASU.Unbounded_String;
            begin
               AD.File_Ops.Create_Unique_File (F, Name, "ABC", "tmp");
               if ASU.Length (Name) > 0 then
                  Ada.Text_IO.Close (F);
                  Epoch := AD.File_Ops.Last_Modified (ASU.To_String (Name));
                  AD.File_Ops.Delete (ASU.To_String (Name));
                  Epoch_Set := True;
               end if;
            end;
         end if;
         declare
            P : constant String := Util.Pathes.Path (Full_Name);
         begin
            if P'Last < P'First or else
               P = '.' & Util.Pathes.Directory_Separator
            then
               --  It's in the current directory!
               Run_Compiler (Full_Name, "-I. " & ASU.To_String (Options));
            else
               if P = "" & Util.Pathes.Directory_Separator then
                  Run_Compiler (Full_Name,
                                ASU.To_String (Options) & " -I" & P & " -I-");
               else
                  Run_Compiler (Full_Name,
                                ASU.To_String (Options) & ' ' &
                                AD.Text_Utilities.Quote
                                  ("-I" & P (P'First .. P'Last - 1)) &
                                " -I-");
                  --  Without the trailing directory separator!
               end if;
            end if;
         end;
         if Is_GNAT then
            --  Try to figure out where the tree file had been written...
            --  Check first the current directory, then try the full name,
            --  then the -T options, then the tree directory from the project
            --  file.
            declare
               S       : constant String := Util.Pathes.Base_Name (Name);
               No_Path : constant ASU.Unbounded_String :=
                 ASU.Null_Unbounded_String;
            begin
               Try_To_Find (Ok, S & ".adt", No_Path, File_Name);
               if not Ok then
                  if Full_Name /= Name then
                     Try_To_Find
                       (Ok, Util.Pathes.Replace_Extension (Full_Name, "adt"),
                        No_Path, File_Name);
                  end if;
                  if not Ok then
                     Try_To_Find
                       (Ok, S & ".adt", Tree_Dirs, File_Name);
                  end if;
               end if;
               if Ok and then Epoch_Set then
                  --  Verify the time stamp: it had better be a new file!
                  declare
                     use AD.File_Ops;
                  begin
                     if Last_Modified (ASU.To_String (File_Name)) < Epoch then
                        AD.Messages.Error
                          ("Found an old tree file at " &
                           ASU.To_String (File_Name));
                        Ok := False;
                     end if;
                  end;
               end if;
            end;
         else
            --  Assume it's ok.
            Ok := True;
         end if;
      end;
   end Create_Unit;

end AD.Compiler;
