Hosted by
 |
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;
package body Messages is
Program_Name : Unbounded_String;
Quiet : Boolean := False;
procedure Debug
(Text : in String) is
begin
Put_Line(Ada.Text_IO.Current_Error, Text);
end Debug;
procedure Debug2
(Text : in String) is
begin
Put(Ada.Text_IO.Current_Error, Text);
end Debug2;
procedure Message
(Text : in String) is
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;
procedure Error
(Text : in String) is
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;
procedure Invalid_Option
(Index : in Positive) is
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;
procedure User_Friendly
(Program_Name : in String;
Parameters : in String;
Description : in String_Array;
Parameters_Text : in String_Array;
Extra_Options : in String_Array;
Index : out Positive;
Exit_Now : out Boolean)
is
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;
end User_Friendly;
end Messages;
|