-------------------------------------------------------------------------------
--
--  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>
--   Main procedure of AdaBrowse.</DL>
--
-- <!--
-- Revision History
--
--   02-FEB-2002   TW  V1.0  First release.
--   04-FEB-2002   TW  V1.01 Added automatic tree file generation. Improved
--                     some error messages. Added "-a | -all" option, which
--                     generates HTML also for all supporters of the given
--                     unit.
--   06-FEB-2002   TW  Added the "-q" and "-x" options, changed behavior of
--                     all options taking filenames (may be in the next arg,
--                     or immediately following the option prefix). Changed
--                     some error handling. Added support for excluding units.
--   07-FEB-2002   TW  Added support for "-I" options with directories that
--                     contain white space. Improved the Asis initialization:
--                     it also catches inconsistencies reported by Asis now
--                     and tries to correct them. Improved the command line
--                     handling (new exception 'Help_Requested').
--   13-MAR-2002   TW  V1.3 Changed to handle several units; added "-i" option
--                     for index creation.
--   14-MAR-2002   TW  Added "-is" option for nested index creation; allow
--                     index generation also if "-all" is given.
--   15-MAR-2002   TW  Added an optional file name argument to "-i" and "-is".
--   19-MAR-2002   TW  V1.33 Corrected plausibility test of filename in -o
--                     option: must not be done if name is "-". Minor change in
--                     'Recreate': pass not just the file name, but also its
--                     path! (Allows 'Create_Unit' to automatically add that
--                     path as a "-I" option to the compile command.)
--                     Correction in 'Process_One_Unit': if it's *not* a
--                     src-vs-tree inconsistency, re-raise the exception.
--   26-MAR-2002   TW  Added support for krunched file names.
--   28-MAR-2002   TW  Added "-t" and "-p" options for type and subprogram
--                     indices. Same syntax as "-i".
--   03-APR-2002   TW  Uses new index package now.
--   24-APR-2002   TW  Uses AD.All_Units now to avoid processing the same unit
--                     multiple times if "-all" in file input mode is given.
--   02-MAY-2002   TW  Added the user-defined HTML tags feature.
--   03-JUL-2002   TW  Added the "-g" option; added logic such that the
--                     general context using all tree files is initialized and
--                     opened only once, and not opened and closed for each
--                     and every input unit. It appears that ASIS-for-GNAT has
--                     a rather huge memory leak on closing a context, and
--                     furthermore, opening a context is slow!
--   20-AUG-2002   TW  Added the "-G" option.
--   28-AUG-2002   TW  Added the "-l" option.
--   11-NOV-2002   TW  Catch Program_Error if it is an "Inconsistent versions
--                     of GNAT and ASIS" bug, so that we don't get the "report
--                     this error" message. I couldn't do anything about it
--                     anyway: you'll have to rebuild AdaBrowse or use the
--                     same GNAT as was used to build AdaBrowse itself. I know,
--                     it's a major nuisance, but I'm not responsible for that.
--                     Complain to ACT, if you like (but I guess they won't
--                     make their ASIS and their tree files compiler version
--                     independent).
--   22-NOV-2002   TW  Added "-private" option.
--   28-APR-2003   TW  Customized ASIS initialization to work around a most
--                     annoying behavior of ASIS-for-GNAT 3.16a.
--   07-JUN-2003   TW  Added support for the GNAT project manager.
--   12-JUN-2003   TW  Changed into a package.
--   30-JUN-2003   TW  Adapted to new index management.
--   09-JUL-2003   TW  Delay processing the -f input until after the project
--                     file has been processed. Also, don't delete the tree
--                     files we generated if we're using a project file: in
--                     that case, the tree directory is ours, and we may well
--                     leave the files there for future re-use.
--   18-NOV-2003   TW  Added -X option for consistency with GNAT's project
--                     manager.
--   19-NOV-2003   TW  Added checks that directories really exist. Additional
--                     check in exception handling for "not compile-only" tree
--                     files.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Characters.Handling;
with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Text_IO;
with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with Asis;
with Asis.Errors;
with Asis.Exceptions;
with Asis.Compilation_Units;
with Asis.Ada_Environments;
with Asis.Implementation;

with Asis2.Naming;

with AD.Compiler;
with AD.Config;
with AD.Crossrefs;
with AD.Environment;
with AD.Exclusions;
with AD.File_Ops;
with AD.Filters;
with AD.HTML;
with AD.Indices.Configuration;
with AD.Messages;
with AD.Options;
with AD.Printers;
with AD.Printers.HTML;
with AD.Printers.XML;
with AD.Projects;
with AD.Queries;
with AD.Parameters;
with AD.Parse;
with AD.Scanner;
with AD.Setup;
with AD.Text_Utilities;
with AD.User_Tags;
with AD.Version;

with Util.Pathes;
with Util.Strings;

pragma Elaborate_All (AD.Projects);
pragma Elaborate_All (AD.Version);

package body AD.Driver is

   package ACH renames Ada.Characters.Handling;
   package ASU renames Ada.Strings.Unbounded;

   package AIC renames AD.Indices.Configuration;

   use Ada.Text_IO;

   use AD.Messages;
   use AD.Printers;
   use AD.Text_Utilities;

   use Util.Strings;

   Help_Requested     : exception;
   Command_Line_Error : exception;
   No_Tree_File       : exception;

   Asis_Context       : Asis.Context;
   Asis_Unit          : Asis.Compilation_Unit;
   Tree_Dirs          : ASU.Unbounded_String;
   Src_Dirs           : ASU.Unbounded_String;
   O_Option_Set       : Boolean := False;

   Has_Project        : Boolean := False;
   Project_File       : ASU.Unbounded_String;

   Pass_On_Options    : ASU.Unbounded_String;

   Print_Src_Names    : Boolean := False;

   type File_Ptr is access Ada.Text_IO.File_Type;

   Src_Files          : File_Ptr;

   Tree_File_Name     : ASU.Unbounded_String;

   Transitive_Closure : Boolean := False;
   Generate_Index     : Boolean := False;

   General_Context_Tried : Boolean := False;
   General_Context_Open  : Boolean := False;

   type Printer_Kinds is
     (HTML_Printer, XML_Printer, DocBook_Printer);

   type Printer_Set is array (Printer_Kinds) of Boolean;

   Enabled_Printers : Printer_Set := (others => False);

   The_Printer      : AD.Printers.Printer_Ref := null;

   Version      : constant String :=
     AD.Version.Get_Version & AD.Projects.Project_Version &
     " (" & AD.Version.Time & " / " & AD.Version.Get_Asis_Version & ')';

   package Handled_Units is

      procedure Add
        (Name : in String);

      function Exists
        (Name : in String)
        return Boolean;

   end Handled_Units;

   package body Handled_Units is separate;

   procedure Handle_Command_Line
     (Quit : out Boolean)
   is
      use Ada.Command_Line;

      procedure Check_Following
        (Curr, Last : in Natural;
         Name       : in String)
      is
      begin
         if Curr > Last then
            Error (Name & " option must be followed by something.");
            raise Command_Line_Error;
         end if;
      end Check_Following;

      procedure Set_Index
        (Idx  : in     AIC.Index_Type;
         Last : in     Natural;
         Curr : in out Natural)
      is
      begin
         AIC.Enter_Index (Idx);
         if Curr < Last then
            declare
               Next : constant String := Argument (Curr + 1);
            begin
               if Next = "-" or else Next (Next'First) /= '-' then
                  Curr := Curr + 1;
                  AIC.Set_File_Name (Idx, Next);
               end if;
            end;
         end if;
      end Set_Index;

      function Quote_If_Needed
        (S : in String)
        return String
      is
      begin
         if S'Length = 0 or else             --  Empty string OR
            S (S'First) = '"' or else        --  Already quoted OR
            Util.Strings.Next_Blank (S) = 0  --  No blanks
         then
            return S;
         end if;
         return Util.Strings.Quote (S, '"', '\');
      end Quote_If_Needed;

      procedure Handle_External_Variable_Assignment
        (S : in String)
      is
      begin
         if S'Length <= 1 or else
            S (S'First) /= '"'
         then
            AD.Environment.Add (S);
         else
            if S (S'Last) /= '"' then
               --  Missing final quote?
               Error ("Unterminated quote in -X option: " & S);
               raise Command_Line_Error;
            end if;
            AD.Environment.Add
              (Util.Strings.Unquote (S (S'First + 1 .. S'Last - 1), '"', '\'));
         end if;
      exception
         when AD.Environment.Invalid_Variable_Assignment =>
            Error ("Invalid -X option: " & S);
            raise Command_Line_Error;
      end Handle_External_Variable_Assignment;

      procedure Add_Directory
        (Flags  : in out ASU.Unbounded_String;
         Flag   : in     String;
         Path   : in     String;
         Quoted : in     Boolean)
      is
         Dir : constant String := Canonical (Path);
      begin
         if not AD.File_Ops.Is_Directory (Dir) then
            Error (Dir & " is an invalid directory (" & Flag & ')');
            raise Command_Line_Error;
         end if;
         if Quoted then
            ASU.Append (Flags, ' ' & Quote_If_Needed (Flag & Dir));
         else
            ASU.Append (Flags, ' ' & Flag & Dir);
         end if;
      end Add_Directory;

      F_Input       : ASU.Unbounded_String;
      File_Name_Set : Boolean := False;
      I             : Natural := 1;
      Print_Version : Boolean := False;

      N             : constant Natural := Argument_Count;
      Max           : Natural          := N;
      --  Used to pass to 'Set_Index' in palce of 'Curr' to suppress the
      --  setting of the file name.

   begin
      if N = 0 then raise Help_Requested; end if;
      Quit := False;
      while I <= N loop
         declare
            S : constant String := Argument (I);
         begin
            if S = "-h"    or else S = "-?" or else
               S = "-help" or else S = "--help"
            then
               raise Help_Requested;
            elsif S = "-G" then
               I := I + 1;
               Check_Following (I, N, S);
               while I <= N loop
                  declare
                     Next : constant String := To_Lower (Argument (I));
                  begin
                     if Next = "html" then
                        Enabled_Printers (HTML_Printer) := True;
                     elsif Next = "xml" then
                        Enabled_Printers (XML_Printer) := True;
                     --  elsif Next = "docbook" then
                     --     Enabled_Printers (DocBook_Printer) := True;
                     else
                        exit;
                     end if;
                  end;
                  I := I + 1;
               end loop;
               I := I - 1;
            elsif S = "-g" then
               AD.Crossrefs.Set_Standard_Units (True);
            elsif S = "-l" then
               AD.Printers.Set_Line_Only;
            elsif S = "-v" or else S = "-version" or else S = "--version" then
               Print_Version := True;
            elsif S = "-o" then
               I := I + 1;
               Check_Following (I, N, S);
               if O_Option_Set then
                  Error ("only one -o option may be given.");
                  raise Command_Line_Error;
               end if;
               AD.Options.Set_Output_Name (Canonical (Argument (I)));
               O_Option_Set := True;
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-o"
            then
               if O_Option_Set then
                  Error ("only one -o option may be given.");
                  raise Command_Line_Error;
               end if;
               AD.Options.Set_Output_Name
                 (Canonical (S (S'First + 2 .. S'Last)));
               O_Option_Set := True;
            elsif S = "-f" then
               I := I + 1;
               Check_Following (I, N, S);
               if File_Name_Set then
                  Warn ("Input already set; " &
                        "ignoring option: " & S & ' ' & Argument (I));
               else
                  F_Input :=
                    ASU.To_Unbounded_String
                      (Canonical (Argument (I)));
                  File_Name_Set := True;
               end if;
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-f"
            then
               if File_Name_Set then
                  Warn ("Input already set; ignoring option: " & S);
               else
                  F_Input :=
                    ASU.To_Unbounded_String
                      (Canonical (S (S'First + 2 .. S'Last)));
                  File_Name_Set := True;
               end if;
            elsif S = "-c" then
               I := I + 1;
               Check_Following (I, N, S);
               AD.Config.Configure (Canonical (Argument (I)));
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-c"
            then
               AD.Config.Configure (Canonical (S (S'First + 2 .. S'Last)));
            elsif S = "-q" then
               AD.Messages.Set_Mode (AD.Messages.Only_Errors);
            elsif S'Length = 3 and then
                  S (S'First .. S'First + 1) = "-w"
            then
               case S (S'First + 2) is
                  when '0' | 'e' =>
                     AD.Messages.Set_Mode (AD.Messages.Only_Errors);
                  when '1' | 'w' =>
                     AD.Messages.Set_Mode (AD.Messages.Errors_And_Warnings);
                  when '2' | 'a' | 'i' =>
                     AD.Messages.Set_Mode (AD.Messages.All_Messages);
                  when 'D' =>
                     AD.Messages.Set_Mode (AD.Messages.Including_Debug);
                     AD.Messages.Debug ("Debug messages activated!");
                  when others =>
                     Error ("unknown warning level on command line.");
                     raise Command_Line_Error;
               end case;
            elsif S = "-s" then
               I := I + 1;
               Check_Following (I, N, S);
               AD.HTML.Set_Style_Sheet (Argument (I));
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-s"
            then
               AD.HTML.Set_Style_Sheet (S (S'First + 2 .. S'Last));
            elsif S = "-is" then
               Set_Index (AIC.Unit_Index, N, I);
               AIC.Set_Structured (AIC.Unit_Index, True);
            elsif S'Length > 3 and then
                  S (S'First .. S'First + 2) = "-is"
            then
               Set_Index (AIC.Unit_Index, N, Max);
               AIC.Set_Structured (AIC.Unit_Index, True);
               AIC.Set_File_Name
                 (AIC.Unit_Index, Canonical (S (S'First + 3 .. S'Last)));
            elsif S = "-i" then
               Set_Index (AIC.Unit_Index, N, I);
               AIC.Set_Structured (AIC.Unit_Index, False);
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-i"
            then
               Set_Index (AIC.Unit_Index, N, Max);
               AIC.Set_Structured (AIC.Unit_Index, False);
               AIC.Set_File_Name
                 (AIC.Unit_Index, Canonical (S (S'First + 2 .. S'Last)));
            elsif S = "-t" then
               Set_Index (AIC.Type_Index, N, I);
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-t"
            then
               Set_Index (AIC.Type_Index, N, Max);
               AIC.Set_File_Name
                 (AIC.Type_Index, Canonical (S (S'First + 2 .. S'Last)));
            elsif S = "-private" or else S = "--private" then
               AD.Options.Set_Private_Too (True);
            elsif S = "-p" then
               Set_Index (AIC.Subprogram_Index, N, I);
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-p"
            then
               Set_Index (AIC.Subprogram_Index, N, Max);
               AIC.Set_File_Name
                 (AIC.Subprogram_Index, Canonical (S (S'First + 2 .. S'Last)));
            elsif S = "-P" then
               I := I + 1;
               Check_Following (I, N, S);
               if Has_Project then
                  Error ("only one -P option may be given.");
                  raise Command_Line_Error;
               end if;
               Has_Project  := True;
               Project_File :=
                 ASU.To_Unbounded_String (Canonical (Argument (I)));
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-P"
            then
               if Has_Project then
                  Error ("only one -P option may be given.");
                  raise Command_Line_Error;
               end if;
               Has_Project  := True;
               Project_File :=
                 ASU.To_Unbounded_String
                 (Canonical (S (S'First + 2 .. S'Last)));
            elsif S = "-X" then
               --  External variable assignment. Applies to project files
               --  *and* to AdaBrowse config files subsequently read.
               --  Syntax: -X name=value or -X "name = value".
               I := I + 1;
               Check_Following (I, N, S);
               Handle_External_Variable_Assignment (Argument (I));
               ASU.Append (Pass_On_Options, " -X" &
                           Quote_If_Needed (Argument (I)));
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-X"
            then
               Handle_External_Variable_Assignment (S (S'First + 2 .. S'Last));
               ASU.Append (Pass_On_Options, " -X" &
                           Quote_If_Needed (S (S'First + 2 .. S'Last)));
            elsif S = "-a" or else S = "-all" or else S = "--all" then
               Transitive_Closure := True;
            elsif S = "-x" then
               AD.Options.Set_Overwrite (False);
            elsif S = "-T" then
               --  Options for Asis.
               I := I + 1;
               Check_Following (I, N, S);
               if Next_Blank (Argument (I)) /= 0 then
                  Error ("Directories for the -T option must not contain " &
                         "white space; option = " &
                         S & " """ & Argument (I) & '"');
                  raise Command_Line_Error;
               end if;
               Add_Directory (Tree_Dirs, "-T", Argument (I), False);
            elsif S'Length > 2 and then
                   S (S'First .. S'First + 1) = "-T"
            then
               --  Options for Asis.
               if Next_Blank (S) /= 0 then
                  Error ("Directories for the -T option must not contain " &
                         "white space; option = " & S);
                  raise Command_Line_Error;
               end if;
               Add_Directory
                 (Tree_Dirs, "-T", S (S'First + 2 .. S'Last), False);
            elsif S = "-I" then
               --  Options for Asis.
               I := I + 1;
               Check_Following (I, N, S);
               Add_Directory (Src_Dirs, "-I", Argument (I), True);
            elsif S'Length > 2 and then
                  S (S'First .. S'First + 1) = "-I"
            then
               --  Options for Asis
               Add_Directory (Src_Dirs, "-I", S (S'First + 2 .. S'Last), True);
            else
               Error ("Unknown command-line option: " & S);
               raise Command_Line_Error;
            end if;
         end;
         I := I + 1;
      end loop;
      if Print_Version then
         Put_Line (Current_Error,
                   "AdaBrowse " & Version &
                   "; Copyright (c) 2002, 2003 by Thomas Wolf");
         if N = 1 then
            Quit := True;
            return;
         end if;
      end if;
      if Has_Project then
         begin
            AD.Projects.Handle_Project_File (ASU.To_String (Project_File));
         exception
            when E : AD.Projects.Project_Error =>
               Error (Ada.Exceptions.Exception_Message (E));
               raise Command_Line_Error;
         end;
      end if;
      Generate_Index := AD.Indices.Has_Indices;
      if File_Name_Set then
         AD.Parameters.Set_Input (ASU.To_String (F_Input));
      else
         if not Has_Project then
            Error ("No input file name! " &
                   "(At least one of -f or -P must be given.)");
            raise Command_Line_Error;
         else
            Info ("Processing all sources in project '" &
                  ASU.To_String (Project_File) & ''');
            Print_Src_Names := True;
            Src_Files := new Ada.Text_IO.File_Type;
            Ada.Text_IO.Create (Src_Files.all, Ada.Text_IO.Out_File);
            AD.Projects.Get_Source_File_List (Src_Files.all);
            Ada.Text_IO.Reset (Src_Files.all, Ada.Text_IO.In_File);
            AD.Parameters.Set_Input
              (Ada.Text_IO.File_Access'(Src_Files.all'Unchecked_Access));
            --  Actually, I think plain 'Access should work just as well,
            --  but unfortunately GNAT 3.15p complains.
         end if;
      end if;
      if Has_Project and then not O_Option_Set then
         declare
            Target : constant String :=
              AD.Projects.Get_Output_Directory;
         begin
            if Target'Length > 0 then
               Info ("Output goes to " & Target);
               if Util.Pathes.Name (Target)'Length > 0 then
                  AD.Options.Set_Output_Name
                    (Target & Util.Pathes.Directory_Separator);
               else
                  AD.Options.Set_Output_Name (Target);
               end if;
               O_Option_Set := True;
            end if;
         end;
      end if;
      if Generate_Index then
         if not AD.Parameters.Is_File and then not Transitive_Closure then
            Warn ("Index generation is only active if AdaBrowse is supposed " &
                  "to process more than one unit. " &
                  "(-f- or -f @file_name or -a or -P project_file)");
            Generate_Index := False;
         elsif AD.Options.Output_Name = "-" then
            Warn ("Index generation turned off because output goes to " &
                  "stdout. (-o- was given.)");
            Generate_Index := False;
         end if;
      end if;
      --  Find out how many printers are enabled.
      declare
         Nof_Printers : Natural := 0;
      begin
         for I in Enabled_Printers'Range loop
            if Enabled_Printers (I) then
               Nof_Printers := Nof_Printers + 1;
            end if;
         end loop;
         if Nof_Printers = 0 then
            --  If no "-G" option was given, enable the HTML printer by
            --  default.
            Nof_Printers := 1;
            Enabled_Printers (HTML_Printer) := True;
         end if;
         if AD.Options.Output_Name = "-" and then Nof_Printers > 1 then
            Error ("Output must not go to stdout if more than one output " &
                   "format is enabled (-G option).");
            raise Command_Line_Error;
         end if;
         if AD.Parameters.Is_File or else Nof_Printers > 1 or else
            Transitive_Closure
         then
            AD.Options.Set_Processing_Mode (AD.Options.Multiple_Files);
         else
            AD.Options.Set_Processing_Mode (AD.Options.Single_File);
         end if;
      end;
      if Has_Project then
         declare
            Prj_Tree_Dir : constant String := AD.Projects.Get_Tree_Directory;
         begin
            if Prj_Tree_Dir'Last >= Prj_Tree_Dir'First then
               ASU.Append (Tree_Dirs, " -T" & Prj_Tree_Dir);
            end if;
            AD.Messages.Info
              ("Tree directory is " & Prj_Tree_Dir);
         end;
         --  We have to change the compile command to ensure that the project
         --  file gets passed along and the compiler thus has the environment
         --  it needs (configuration pragmas, naming schemes, etc.)
         --     Note: we also pass on -X options!
         AD.Compiler.Set_Compile_Command
           ("gnat compile -c -gnatc -gnatt -P" &
            AD.Projects.Get_Project_File_Name &
            ASU.To_String (Pass_On_Options));
      end if;
   exception
      when Command_Line_Error =>
         --  Check if there's a help option somewhere. If so, translate this
         --  into a Help_Requested. (This allows the user to simply re-use a
         --  command that previously terminated with a Command_Line_Error with
         --  an additional help option at the end to get the help. I find this
         --  personally useful because it saves typing; since most command
         --  shells support a "command history", I can get the help by typing
         --  <UP-ARROW> -?<RETURN>, which is way faster than having to type
         --  adabrowse -?<RETURN>.)
         I := I + 1;
         --  We failed on argument I, so we only need to check the remaining
         --  arguments.
         while I <= N loop
            declare
               S : constant String := Argument (I);
            begin
               exit when S = "-?"    or else S = "-h" or else
                         S = "-help" or else S = "--help";
            end;
            I := I + 1;
         end loop;
         if I <= N then
            raise Help_Requested;
         else
            raise;
         end if;
   end Handle_Command_Line;

   procedure Report
     (Debug_Only : Boolean := False)
   is
      use type AD.Messages.Verbosity;
   begin
      if not Debug_Only or else
         AD.Messages.Get_Mode = AD.Messages.Including_Debug
      then
         Put_Line (Current_Error,
                   "*** Please report this error to " &
                   AD.Version.Get_Maintainer &
                   ", giving the AdaBrowse version,");
         Put_Line (Current_Error,
                   "host environment, GNAT version, and all input files" &
                   " (Ada sources, style sheets ");
         Put_Line (Current_Error,
                   "and configuration files).");
         Put_Line (Current_Error,
                   "This is AdaBrowse " & Version &
                   "; Copyright (c) 2002, 2003 by Thomas Wolf");
      end if;
   end Report;

   procedure Report_No_GNATC
     (E         : in Ada.Exceptions.Exception_Occurrence;
      Asis_Info : in String)
   is
   begin
      Error ("Fatal ASIS failure. It seems like some tree files have");
      Error ("been compiled with only ""-gnatt"" (no ""-gnatc"").");
      Error ("Verify this, and if the error doesn't go away, re-run");
      Error ("AdaBrowse with the ""-wD"" option to get more information.");
      Debug (Ada.Exceptions.Exception_Information (E));
      Debug (Asis_Info);
      Report (Debug_Only => True);
   end Report_No_GNATC;

   procedure Recreate
   is
      --  Call the compiler (if any) to try to recreate the ASIS-information.
      --  Raises 'No_Tree' if a compilation command is set, but fails. If
      --  no compilation command is defined, nothing at all happens. Assumes
      --  'Asis_Context' to be closed upon entry and, if compilation was
      --  successful, tries to open it.
      --     Hmmm... what happens here if the command reads from stdin, or
      --  does not return? For the time being, we just assume that compilers
      --  don't do such nasty things!
      Ok : Boolean := False;
   begin
      if AD.Compiler.Get_Compile_Command /= "" then
         Info ("Trying to recompile """ & AD.Parameters.Source_Name & """...");
         AD.Compiler.Create_Unit
           (Util.Pathes.Concat
              (AD.Parameters.Path, AD.Parameters.Source_Name),
            Src_Dirs, Tree_Dirs, Tree_File_Name, Ok);
         if Ok then
            Info ("Recompilation of """ & AD.Parameters.Source_Name &
                  """ was successful.");
            --  Success! Re-open the context and try again.
            Asis.Ada_Environments.Associate
              (The_Context => Asis_Context,
               Name        => "AdaBrowse_Context",
               Parameters  => To_Wide_String ("-C1 -FT -SA -T. " &
                                              ASU.To_String (Tree_File_Name)));
            Asis.Ada_Environments.Open (Asis_Context);
         else
            raise No_Tree_File;
         end if;
      end if;
   end Recreate;

   procedure Transform_Unit
     (Unit : in Asis.Compilation_Unit)
   is
   begin
      AD.Scanner.Scan (Unit, The_Printer);
      AD.User_Tags.Reset_Tags;
   exception
      when others =>
         begin
            Asis.Ada_Environments.Close (Asis_Context);
            Asis.Ada_Environments.Dissociate (Asis_Context);
            Asis.Implementation.Finalize ("");
         exception
            when others =>
               null;
         end;
         raise;
   end Transform_Unit;

   procedure Process_One_Unit
   is

      procedure Delete_ADT
      is
      begin
         if ASU.Length (Tree_File_Name) > 0 and then not Has_Project then
            --  We created a tree file: try to delete it!
            --  (But only if we're not working from a project file: project
            --  files have a tree directory, and that's ours!)
            declare
               ADT_Name : constant String := ASU.To_String (Tree_File_Name);
            begin
               AD.File_Ops.Delete (ADT_Name);
               --  And GNAT also creates a "*.ali" file...
               AD.File_Ops.Delete
                 (ADT_Name (ADT_Name'First .. ADT_Name'Last - 3) & "ali");
            end;
         end if;
         Tree_File_Name := ASU.Null_Unbounded_String;
      exception
         when others =>
            --  Swallow the exception!
            Tree_File_Name := ASU.Null_Unbounded_String;
      end Delete_ADT;

      Skip_Unit : exception;

      use type Ada.Exceptions.Exception_Id;

   begin
      if Handled_Units.Exists (AD.Parameters.Unit_Name) then return; end if;
      if Print_Src_Names then
         Info ("Processing file """ & AD.Parameters.Source_Name & '"');
      end if;
      --  Now try to open the Asis context. This is pretty complex. By default,
      --  we use all tree files, but if ASIS detects an inconsistency, we first
      --  need to hack around to properly detect that, then try to recompile
      --  the given file, and finally re-open the context with options telling
      --  ASIS to use only that new tree file.

      Init_Asis :
      declare
         Already_Tried_To_Create : Boolean := False;
      begin
         Initially :
         begin
            if not General_Context_Tried then
               General_Context_Tried := True;
               Asis.Ada_Environments.Associate
                 (The_Context => Asis_Context,
                  Name        => "AdaBrowse_Context",
                  Parameters  => To_Wide_String
                                   ("-CA -FT -SA " &
                                    ASU.To_String (Tree_Dirs)));
               --  use "-FM -SA" (generate tree files as needed)?
               --  use "-I<dir>" (directories to search for sources)
               --  use "-T<dir>" (directories to search for trees)
               --
               --  Default is "-CA -FT -SA" (all tree files found, no automatic
               --  tree generation, use all sources for consistency checks).
               --
               --  Note that "-FM" requires "-SA"! Also note that it is
               --  absolutely unclear what happens with any generated tree
               --  files when the context is closed. Neither the ASIS-for-GNAT
               --  RM  nor the UG say whether or not these files are deleted
               --  once the last context using them is closed... They also
               --  don't say where these files are created: in the current
               --  directory, in a directory given by a "-T" option, or in
               --  the system's temporary directory? Probably in the current
               --  directory, following the "gcc" command launched internally.
               --
               --  Note: for the time being, we do not use "-FM": some ASIS
               --  queries (e.g. Corresponding_Children) are implemented only
               --  for "-FT"!

               Asis.Ada_Environments.Open (Asis_Context);
               General_Context_Open := True;
            elsif not General_Context_Open then
               Already_Tried_To_Create := True;
               Recreate;
            end if;
         exception
            when Asis.Exceptions.ASIS_Failed =>
               if AD.Compiler.Get_Compile_Command = "" then
                  raise;
               end if;
               --  ASIS-for-GNAT specific!
               declare
                  Msg : constant String  :=
                    Trim (To_String (Asis.Implementation.Diagnosis));
                  I   : Natural :=
                    Index (Msg, " is inconsistent with a tree file");
               begin
                  if I = 0 then
                     I := Index (Msg, "does not exist");
                  end if;
                  if I > 0 then
                     --  It *is* indeed a source-vs-tree
                     --  inconsistency!
                     Warn (Msg);
                     --  Close the context again and try to recreate
                     --  the ASIS info and then re-open the context.
                     if Asis.Ada_Environments.Is_Open (Asis_Context) then
                        Asis.Ada_Environments.Close (Asis_Context);
                     end if;
                     Asis.Ada_Environments.Dissociate (Asis_Context);
                     General_Context_Open    := False;
                     Already_Tried_To_Create := True;
                     Recreate;
                  else
                     raise;
                  end if;
               end;
         end Initially;

         Asis_Unit :=
           Asis.Compilation_Units.Library_Unit_Declaration
             (To_Wide_String (AD.Parameters.Unit_Name), Asis_Context);

         if Asis.Compilation_Units.Is_Nil (Asis_Unit) then
            --  Hmmm... might be a krunched file name: try to find the source
            --  file, and extract the unit name from the source!
            declare
               Full_Name : constant String :=
                 AD.File_Ops.Find
                   (Util.Pathes.Concat
                      (AD.Parameters.Path, AD.Parameters.Source_Name),
                    Src_Dirs);
            begin
               if Full_Name'Last >= Full_Name'First then
                  declare
                     True_Name : constant String :=
                       AD.Parse.Get_Unit_Name (Full_Name);
                  begin
                     if True_Name'Last >= True_Name'First and then
                        To_Lower (True_Name) /=
                        To_Lower (AD.Parameters.Unit_Name)
                     then
                        if Handled_Units.Exists (True_Name) then
                           raise Skip_Unit;
                        end if;
                        Info ("File """ & Full_Name &
                              """ contains a unit named """ & True_Name & '"');
                        AD.Parameters.Set_Unit_Name (True_Name);
                        Asis_Unit :=
                          Asis.Compilation_Units.Library_Unit_Declaration
                            (To_Wide_String (True_Name), Asis_Context);
                     end if;
                  end;
               end if;
            end;
         end if;

         if Asis.Compilation_Units.Is_Nil (Asis_Unit) and then
            not (Already_Tried_To_Create) and then
            AD.Compiler.Get_Compile_Command /= ""
         then
            --  Not found: Close the context again and then try to generate the
            --  tree and re-open the context.
            Asis.Ada_Environments.Close (Asis_Context);
            Asis.Ada_Environments.Dissociate (Asis_Context);
            Warn ("Couldn't find unit """ & AD.Parameters.Unit_Name &
                  """ in the library.");
            General_Context_Open := False;
            Recreate;
            --  Try again.
            Asis_Unit :=
              Asis.Compilation_Units.Library_Unit_Declaration
                (To_Wide_String (AD.Parameters.Unit_Name), Asis_Context);
         end if;
      end Init_Asis;

      if Asis.Compilation_Units.Is_Nil (Asis_Unit) then
         --  Still not found: abandon!
         Asis.Ada_Environments.Close (Asis_Context);
         Asis.Ada_Environments.Dissociate (Asis_Context);
         raise Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit;
      end if;

      Generate_Main :
      declare
         Unit_Name : constant String :=
           To_String (Asis2.Naming.Full_Unit_Name (Asis_Unit));
      begin
         if not Handled_Units.Exists (Unit_Name) then
            Handled_Units.Add (Unit_Name);
            if AD.Exclusions.Is_Excluded (To_Lower (Unit_Name)) then
               Info
                 ("There's an EXCLUDE key in some configuration file for " &
                  "the given unit """ & Unit_Name & """. Unit is skipped.");
               raise Skip_Unit;
            else
               Transform_Unit (Asis_Unit);
            end if;
         else
            if AD.Exclusions.Is_Excluded (To_Lower (Unit_Name)) then
               raise Skip_Unit;
            end if;
         end if;
      end Generate_Main;

      if Transitive_Closure then
         Generate_Closure :
         declare
            All_Units : constant Asis.Compilation_Unit_List :=
              AD.Queries.Get_Dependents (Asis_Unit);
         begin
            for I in All_Units'Range loop
               if
                 not Asis.Compilation_Units.Is_Equal (All_Units (I), Asis_Unit)
               then
                  --  The "if" is just paranoia; I suppose we should never get
                  --  back the unit itself.
                  declare
                     Unit_Name : constant String :=
                       To_String (Asis2.Naming.Full_Unit_Name (All_Units (I)));
                  begin
                     if not Handled_Units.Exists (Unit_Name) then
                        Handled_Units.Add (Unit_Name);
                        if AD.Exclusions.Skip (To_Lower (Unit_Name)) then
                           Info
                             ("The unit """ & Unit_Name & """ is excluded" &
                              " by an EXCLUDE or NO_XREF key in some" &
                              " configuration file.");
                        else
                           Transform_Unit (All_Units (I));
                        end if;
                     end if;
                  end;
               end if;
            end loop;
         end Generate_Closure;
      end if;

      --  No exception: successful termination

      if not General_Context_Open and then
         Asis.Ada_Environments.Is_Open (Asis_Context)
      then
         Asis.Ada_Environments.Close (Asis_Context);
         Asis.Ada_Environments.Dissociate (Asis_Context);
      end if;
      Delete_ADT;

   exception
      when E : others =>
         if not General_Context_Open and then
            Asis.Ada_Environments.Is_Open (Asis_Context)
         then
            Asis.Ada_Environments.Close (Asis_Context);
            Asis.Ada_Environments.Dissociate (Asis_Context);
         end if;
         Delete_ADT;
         if Ada.Exceptions.Exception_Identity (E) /= Skip_Unit'Identity then
            raise;
         end if;
   end Process_One_Unit;

   procedure Init_Asis
   is
      ASIS_Version : constant String := AD.Version.Get_Asis_Version;
      Pattern_GNAT : constant String := "for GNAT";
      Pattern_Pro  : constant String := "Pro";
      I            : Natural;
   begin
      --  Search for "for GNAT", then skip blanks, then get a sequence of
      --  digits and periods.
      I := Util.Strings.First_Index (ASIS_Version, Pattern_GNAT);
      if I = 0 then
         --  Not an ASIS-for-GNAT?
         Asis.Implementation.Initialize (Parameters => "");
      else
         I :=
           Next_Non_Blank
             (ASIS_Version (I + Pattern_GNAT'Length .. ASIS_Version'Last));
         --  Some GNAT versions may have a version string "for GNAT Pro x.yy"!
         if I /= 0 and then
            Is_Prefix (ASIS_Version (I .. ASIS_Version'Last), Pattern_Pro)
         then
            I :=
              Next_Non_Blank
                (ASIS_Version (I + Pattern_Pro'Length .. ASIS_Version'Last));
         end if;
         declare
            Major_Version : Natural := 3;
            Minor_Version : Natural := 15;
         begin
            if I /= 0 and then ACH.Is_Digit (ASIS_Version (I)) then
               Major_Version := Natural (Character'Pos (ASIS_Version (I)) -
                                         Character'Pos ('0'));
               I := I + 1;
               if I <= ASIS_Version'Last and then ASIS_Version (I) = '.' then
                  declare
                     J : Natural := I + 1;
                  begin
                     while J <= ASIS_Version'Last and then
                           ACH.Is_Digit (ASIS_Version (J))
                     loop
                        J := J + 1;
                     end loop;
                     if J > I + 1 then
                        Minor_Version :=
                          Natural'Value (ASIS_Version (I + 1 .. J - 1));
                     end if;
                  end;
               end if;
            end if;
            if Major_Version < 3 or else
               (Major_Version = 3 and then Minor_Version <= 15)
            then
               Asis.Implementation.Initialize (Parameters => "-ws");
               --  "-ws" means "suppress all warnings". In particular, we want
               --  to suppress the warnings about some body tree files not
               --  being present. As we process only specs, we don't care:
               --  the body trees needed for generic instantiations are
               --  included in the specs containing these instantiations
               --  anyway.
            else
               --  Use from GNAT 3.16 on (3.16, 3.17, 5.00, ...)
               Asis.Implementation.Initialize (Parameters => "-ws -k -nbb");
               --  "-k" means keep going; never, ever make the program quit.
               --  Hey, it's awful library design if a library can force the
               --  program using it to quit. Sergey, you'd better undo that
               --  immediately!
               --
               --  "-nbb" tells ASIS not to generate a GNAT-style bug-box on
               --  stderr, giving instructions how to submit a bug report to
               --  ACT. For heaven's sake, what kind of nonsense is this?! It's
               --  the application using ASIS-for-GNAT that has the sole right
               --  to decide what to do in the presence of fatal errors, such
               --  as bugs in ASIS. Maybe it can work around the bugs, or tell
               --  the users to submit bug reports somewhere else (e.g., to
               --  report them to me!).
            end if;
         end;
      end if;
   end Init_Asis;

   procedure Shutdown
     (Normal : in Boolean)
   is
   begin
      if Asis.Ada_Environments.Is_Open (Asis_Context) then
         --  Must be the general context...
         Asis.Ada_Environments.Close (Asis_Context);
         Asis.Ada_Environments.Dissociate (Asis_Context);
      end if;

      if Normal and then Generate_Index then
         AD.Indices.Write (The_Printer);
      end if;

      AD.Parameters.Close;
      Asis.Implementation.Finalize ("");

      AD.Printers.Free (The_Printer);

      declare
         use type Ada.Text_IO.File_Access;

         procedure Free is
            new Ada.Unchecked_Deallocation
                  (Ada.Text_IO.File_Type, File_Ptr);
      begin
         if Src_Files /= null then
            if Ada.Text_IO.Is_Open (Src_Files.all) then
               Ada.Text_IO.Close (Src_Files.all);
            end if;
            Free (Src_Files);
         end if;
      end;

      if Normal then
         AD.Projects.Reset (On_Error => False);
         Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success);
      else
         AD.Projects.Reset (On_Error => True);
         Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
      end if;

   end Shutdown;

   procedure Main
   is
   begin -- AdaBrowse Main routine

      AD.Crossrefs.Set_Standard_Units (False);

      AD.Projects.Initialize;

      Parse_Command_Line :
      declare
         Quit : Boolean;
      begin
         Handle_Command_Line (Quit);
         if Quit then
            Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success);
            return;
         end if;
      end Parse_Command_Line;

      AD.User_Tags.Verify;

      --  Set up the enabled printers.

      for I in Enabled_Printers'Range loop
         if Enabled_Printers (I) then
            case I is
               when HTML_Printer =>
                  The_Printer :=
                    The_Printer + Printer_Ref'(new AD.Printers.HTML.Printer);
               when XML_Printer =>
                  The_Printer :=
                    The_Printer + Printer_Ref'(new AD.Printers.XML.Printer);
               when DocBook_Printer =>
                  --  The_Printer :=
                  --    The_Printer + new AD.Printers.DocBook_Printer;
                  null;
            end case;
         end if;
      end loop;

      --  Now initialize Asis. This is highly GNAT-specific!

      Init_Asis;

      --  Set up index management.

      if Generate_Index then
         AD.Indices.Verify;
      else
         AD.Indices.Disable;
      end if;

      --  Set the output directory.

      if AD.Options.Output_Directory = "" and then
         AD.Parameters.Path /= ""
      then
         AD.Options.Set_Output_Directory (AD.Parameters.Path);
      end if;

      --  Process the input files.

      loop
         Process_One_Unit;
         exit when not AD.Parameters.Advance_Input;
      end loop;

      Shutdown (True);

   exception
      when others =>
         Exception_Handler :
         begin
            Shutdown (False);
            raise;
         exception
            when E : AD.Printers.Open_Failed |
                 AD.Printers.Cannot_Overwrite |
                 AD.Config.Invalid_Config |
                 AD.Parameters.Input_Error |
                 AD.Filters.Recursive_Expansion =>
               Error (Ada.Exceptions.Exception_Message (E));

            when No_Tree_File =>
               Error
                 ("Couldn't find unit """ & AD.Parameters.Unit_Name &
                  """ in the library.");
               if AD.Compiler.Get_Compile_Command /= "" then
                  if Index (AD.Version.Get_Version, "GNAT") > 0 then
                     Error ("Couldn't find nor generate a tree " &
                            "file. Try generating one ");
                     Error ("using the command """ & AD.Setup.GNAT_Name &
                            " -c -gnatc -gnatt ...""");
                  else
                     Error ("Couldn't generate the necessary info " &
                            "either with """ &
                            AD.Compiler.Get_Compile_Command &
                            " ...""");
                  end if;
               end if;

            when Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit =>
               Error ("Couldn't find unit """ & AD.Parameters.Unit_Name &
                      """ in the library, or");
               Error ("the file """ & AD.Parameters.Source_Name &
                      """ does not contain any Ada spec.");
               Put_Line (Current_Error,
                         "Type ""adabrowse -?"" for more information.");

            when Command_Line_Error =>
               Put_Line (Current_Error,
                         "Type ""adabrowse -?"" for more information.");

            when Help_Requested =>
               AD.Messages.Help_Text;

            when E : others =>
               declare
                  use Ada.Exceptions;
                  Handled : Boolean := False;
               begin
                  if Exception_Identity (E) =
                     Asis.Exceptions.ASIS_Failed'Identity
                  then
                     declare
                        use Asis.Errors;
                     begin
                        case Asis.Implementation.Status is
                           when Asis.Errors.Use_Error |
                                Obsolete_Reference_Error =>
                              --  ASIS-for-GNAT specific!
                              declare
                                 Msg : constant String  :=
                                   Trim
                                     (To_String
                                        (Asis.Implementation.Diagnosis));
                              begin
                                 if Index (Msg,
                                           " is inconsistent with a tree file")
                                    > 0
                                 then
                                    Handled := True;
                                    Error (Msg);
                                 elsif Index (Msg, "not compile-only") > 0 then
                                    Handled := True;
                                    Report_No_GNATC (E, Trim (Msg));
                                 end if;
                              end;

                           when Parameter_Error =>
                              Handled := True;
                              Error
                                (Trim
                                 (To_String (Asis.Implementation.Diagnosis)));

                           when Not_Implemented_Error =>
                              Handled := True;
                              Error ("ASIS doesn't implement a query!");
                              Error (Ada.Exceptions.Exception_Information (E));
                              Error
                                (Trim
                                 (To_String (Asis.Implementation.Diagnosis)));
                              Report;

                           when others =>
                              declare
                                 Msg : constant String :=
                                   To_String (Asis.Implementation.Diagnosis);
                              begin
                                 if (First_Index
                                     (To_Lower (Msg), "constraint_error") > 0
                                     and then
                                     First_Index
                                     (To_Lower (Msg), "namet.adb") > 0)
                                    or else
                                    (First_Index
                                     (To_Lower (Msg),
                                      "internal_implementation_error") > 0
                                     and then
                                     First_Index
                                     (To_Lower (Msg), "a4g-contt-ut.adb") > 0)
                                 then
                                    Handled := True;
                                    Report_No_GNATC (E, Trim (Msg));
                                 end if;
                              end;

                        end case;
                     end;
                  elsif Exception_Identity (E) = Program_Error'Identity then
                     declare
                        Msg : constant String := Exception_Message (E);
                     begin
                        if Is_Prefix (Msg, "Inconsistent versions") then
                           Handled := True;
                           Error (Msg);
                           Put_Line
                             (Current_Error,
                              "**** AdaBrowse has been compiled for " &
                              AD.Version.Get_Asis_Version & ',');
                           Put_Line
                             (Current_Error,
                              "but some tree file has been generated by " &
                              "some other compiler.");
                           Put_Line
                             (Current_Error,
                              "Make sure that the tree files are generated " &
                              "by the compiler above,");
                           Put_Line
                             (Current_Error,
                              "or rebuild AdaBrowse from the sources with " &
                              "your other compiler.");
                        end if;
                     end;
                  end if;
                  if not Handled then
                     Error ("An unexpected error occurred!");
                     Error (Ada.Exceptions.Exception_Information (E));
                     Error (Trim (To_String (Asis.Implementation.Diagnosis)));
                     Report;
                  end if;
               end;
         end Exception_Handler;

   end Main;

end AD.Driver;
