-- $Date: 2004/01/13 03:34:14 $
-- $Revision: 1.5 $
-- $Author: jcrocholl $

with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;

package body Messages is

   -- Name of the program executable, without extension.
   Program_Name : Unbounded_String;

   -- User doesn't want status messages.
   Quiet : Boolean := False;

   -- Print a message to error output, followed by a newline.
   procedure Debug
     (Text : in String) is -- Print this message.
   begin
      Put_Line(Ada.Text_IO.Current_Error, Text);
   end Debug;

   -- Print a message to error output, no newline.
   procedure Debug2
     (Text : in String) is -- Print this message.
   begin
      Put(Ada.Text_IO.Current_Error, Text);
   end Debug2;

   -- If not in quiet mode, print the program name (if non-empty) and
   -- the message text to error output, followed by a newline.
   procedure Message
     (Text : in String) is -- Print this message.
   begin
      if not Quiet then
         if Program_Name /= Null_Unbounded_String
         then Put_Line(Ada.Text_IO.Current_Error, To_String(Program_Name) & ": " & Text);
         else Put_Line(Ada.Text_IO.Current_Error, Text);
         end if;
      end if;
   end Message;

   -- Print the program name (if non-empty) and the error message text
   -- to error output, followed by a newline. Set exit status to
   -- failure.
   procedure Error
     (Text : in String) is -- Print this error message.
   begin
      if Program_Name /= Null_Unbounded_String
      then Put_Line(Ada.Text_IO.Current_Error, To_String(Program_Name) & ": " & Text);
      else Put_Line(Ada.Text_IO.Current_Error, Text);
      end if;
      Set_Exit_Status(Failure);
   end Error;

   procedure Try_Help is
   begin
      Error("Try --help for more information.");
   end Try_Help;

   -- The option with the given argument is invalid.
   procedure Invalid_Option
     (Index : in Positive) is -- Print the argument at this index.
   begin
      Error("Option " & Argument(Index) & " is invalid.");
      Try_Help;
   end Invalid_Option;

   procedure Too_Few_Arguments is
   begin
      Error("Too few command line arguments.");
      Try_Help;
   end Too_Few_Arguments;

   -- Handling for common options like -v and -h.
   procedure User_Friendly
     (Program_Name    : in String;       -- Name of executable.
      Parameters      : in String;       -- List of parameters.
      Description     : in String_Array-- What does the program do?
      Parameters_Text : in String_Array-- Text for parameters.
      Extra_Options   : in String_Array-- Options beyond -h, -v, -q.
      Index           : out Positive;    -- First unhandled parameter.
      Exit_Now        : out Boolean)     -- Exit program instantly.
   is

      -- Print version information.
      procedure Version is
      begin
         Put_Line(Program_Name & " v0.1 http://roemer.sourceforge.net");
         Set_Exit_Status(Success);
         Exit_Now := True;
      end Version;

      procedure Usage is
      begin
         Put_Line("Usage: " &
           To_String(Messages.Program_Name) &
           " [options] " & Parameters);
         Put_Line("");
         for Index in Description'Range loop
            Put_Line(To_String(Description(Index)));
         end loop;
         if Parameters_Text'Length /= 0 then
            Put_Line("");
            Put_Line("Parameters:");
            for Index in Parameters_Text'Range loop
               Put_Line(To_String(Parameters_Text(Index)));
            end loop;
         end if;
         Put_Line("");
         Put_Line("Options:");
         Put_Line("-v, --version Display version information and exit.");
         Put_Line("-h, --help Display this help and exit.");
         Put_Line("-q, --quiet Quiet operation, don't show actions.");
         for Index in Extra_Options'Range loop
            Put_Line(To_String(Extra_Options(Index)));
         end loop;
         Set_Exit_Status(Success);
         Exit_Now := True;
      end Usage;

      procedure Combine_Error
        (Index : in Positive) is
      begin
         Error("Command line parameter " & Argument(Index) & " can only be used alone.");
         Try_Help;
         Exit_Now := True;
      end Combine_Error;

      function Extract_Filename
        (Path : in String)
        return String
      is
         Start : Natural;
      begin
         Start := Path'Last;
         while Start >= Path'First loop
            exit when Path(Start) = '/';
            exit when Path(Start) = '\';
            Start := Start - 1;
         end loop;
         return Path(Start + 1 .. Path'Last);
      end Extract_Filename;

   begin
      Index := 1;
      Exit_Now := False;
      Messages.Program_Name := -Extract_Filename(Command_Name);

      if Argument_Count = 1 then
         if Argument(Index) = "-v" or Argument(Index) = "--version" then Version; return; end if;
         if Argument(Index) = "-h" or Argument(Index) = "--help" then Usage; return; end if;
      end if;

      for Index in 1 .. Argument_Count loop
         if Argument(Index) = "-v" or Argument(Index) = "--version" then Combine_Error(Index); return; end if;
         if Argument(Index) = "-h" or Argument(Index) = "--help" then Combine_Error(Index); return; end if;
         if Argument(Index) = "-q" or Argument(Index) = "--quiet" then Quiet := True; end if;
      end loop;

      -- if Argument_Count < Parameters_Text'Length then Too_Few_Parameters; return; end if;
   end User_Friendly;

end Messages;