-- ungrouping common prefixes when possible), and call Callback for each of
-- these.
+ procedure Sort_Sections
+ (Line : GNAT.OS_Lib.Argument_List_Access;
+ Sections : GNAT.OS_Lib.Argument_List_Access;
+ Params : GNAT.OS_Lib.Argument_List_Access);
+ -- Reorder the command line switches so that the switches belonging to a
+ -- section are grouped together.
+
procedure Group_Switches
- (Cmd : Command_Line;
- Result : Argument_List_Access;
- Params : Argument_List_Access);
+ (Cmd : Command_Line;
+ Result : Argument_List_Access;
+ Sections : Argument_List_Access;
+ Params : Argument_List_Access);
-- Group switches with common prefixes whenever possible.
-- Once they have been grouped, we also check items for possible aliasing
Append (Config.Prefixes, new String'(Prefix));
end Define_Prefix;
+ --------------------
+ -- Define_Section --
+ --------------------
+
+ procedure Define_Section
+ (Config : in out Command_Line_Configuration;
+ Section : String)
+ is
+ begin
+ if Config = null then
+ Config := new Command_Line_Configuration_Record;
+ end if;
+
+ Append (Config.Sections, new String'(Section));
+ end Define_Section;
+
-----------------------
-- Set_Configuration --
-----------------------
Getopt_Description : String := "";
Switch_Char : Character := '-')
is
- Tmp : Argument_List_Access;
- Parser : Opt_Parser;
- S : Character;
+ Tmp : Argument_List_Access;
+ Parser : Opt_Parser;
+ S : Character;
+ Section : String_Access := null;
+
+ function Real_Full_Switch
+ (S : Character;
+ Parser : Opt_Parser) return String;
+ -- Ensure that the returned switch value contains the
+ -- Switch_Char prefix if needed.
+
+ ----------------------
+ -- Real_Full_Switch --
+ ----------------------
+
+ function Real_Full_Switch
+ (S : Character;
+ Parser : Opt_Parser) return String
+ is
+ begin
+ if S = '*' then
+ return Full_Switch (Parser);
+ else
+ return Switch_Char & Full_Switch (Parser);
+ end if;
+ end Real_Full_Switch;
+
+ -- Start of processing for Set_Command_Line
begin
Free (Cmd.Expanded);
Parser => Parser);
exit when S = ASCII.NUL;
- if S = '*' then
- Add_Switch (Cmd, Full_Switch (Parser), Parameter (Parser),
- Separator (Parser));
- else
- Add_Switch
- (Cmd, Switch_Char & Full_Switch (Parser),
- Parameter (Parser), Separator (Parser));
- end if;
+ declare
+ Sw : constant String :=
+ Real_Full_Switch (S, Parser);
+ Is_Section : Boolean := False;
+
+ begin
+ if Cmd.Config /= null
+ and then Cmd.Config.Sections /= null
+ then
+ Section_Search :
+ for S in Cmd.Config.Sections'Range loop
+ if Sw = Cmd.Config.Sections (S).all then
+ Section := Cmd.Config.Sections (S);
+ Is_Section := True;
+
+ exit Section_Search;
+ end if;
+ end loop Section_Search;
+ end if;
+
+ if not Is_Section then
+ if Section = null then
+ Add_Switch
+ (Cmd, Sw,
+ Parameter (Parser),
+ Separator (Parser));
+ else
+ Add_Switch
+ (Cmd, Sw,
+ Parameter (Parser),
+ Separator (Parser),
+ Section.all);
+ end if;
+ end if;
+ end;
exception
when Invalid_Parameter =>
+
-- Add it with no parameter, if that's the way the user
- -- wants it
- Add_Switch (Cmd, Switch_Char & Full_Switch (Parser));
+ -- wants it.
+
+ if Section = null then
+ Add_Switch
+ (Cmd, Switch_Char & Full_Switch (Parser));
+ else
+ Add_Switch
+ (Cmd, Switch_Char & Full_Switch (Parser), Section.all);
+ end if;
end;
end loop;
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
- Separator : Character := ' ')
+ Separator : Character := ' ';
+ Section : String := "")
is
procedure Add_Simple_Switch (Simple : String);
-- Add a new switch that has had all its aliases expanded, and switches
Cmd.Params := new Argument_List'
(1 .. 1 => new String'(Separator & Parameter));
end if;
-
+ if Section = "" then
+ Cmd.Sections := new Argument_List'(1 .. 1 => null);
+ else
+ Cmd.Sections := new Argument_List'
+ (1 .. 1 => new String'(Section));
+ end if;
else
-- Do we already have this switch ?
or else
(Cmd.Params (C) /= null
and then Cmd.Params (C).all = Separator & Parameter))
+ and then
+ ((Cmd.Sections (C) = null and then Section = "")
+ or else
+ (Cmd.Sections (C) /= null
+ and then Cmd.Sections (C).all = Section))
then
return;
end if;
else
Append (Cmd.Params, new String'(Separator & Parameter));
end if;
+
+ if Section = "" then
+ Append (Cmd.Sections, null);
+ else
+ Append (Cmd.Sections, new String'(Section));
+ end if;
end if;
end Add_Simple_Switch;
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
- Remove_All : Boolean := False)
+ Remove_All : Boolean := False;
+ Section : String := "")
is
procedure Remove_Simple_Switch (Simple : String);
-- Removes a simple switch, with no aliasing or grouping
if Cmd.Expanded /= null then
C := Cmd.Expanded'First;
while C <= Cmd.Expanded'Last loop
- if Cmd.Expanded (C).all = Simple then
+ if Cmd.Expanded (C).all = Simple
+ and then
+ (Remove_All
+ or else (Cmd.Sections (C) = null
+ and then Section = "")
+ or else (Cmd.Sections (C) /= null
+ and then Section = Cmd.Sections (C).all))
+ then
Remove (Cmd.Expanded, C);
Remove (Cmd.Params, C);
+ Remove (Cmd.Sections, C);
if not Remove_All then
return;
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
- Parameter : String)
+ Parameter : String;
+ Section : String := "")
is
procedure Remove_Simple_Switch (Simple : String);
-- Removes a simple switch, with no aliasing or grouping
while C <= Cmd.Expanded'Last loop
if Cmd.Expanded (C).all = Simple
and then
+ ((Cmd.Sections (C) = null
+ and then Section = "")
+ or else
+ (Cmd.Sections (C) /= null
+ and then Section = Cmd.Sections (C).all))
+ and then
((Cmd.Params (C) = null and then Parameter = "")
or else
(Cmd.Params (C) /= null
then
Remove (Cmd.Expanded, C);
Remove (Cmd.Params, C);
+ Remove (Cmd.Sections, C);
-- The switch is necessarily unique by construction of
-- Add_Switch
--------------------
procedure Group_Switches
- (Cmd : Command_Line;
- Result : Argument_List_Access;
- Params : Argument_List_Access)
+ (Cmd : Command_Line;
+ Result : Argument_List_Access;
+ Sections : Argument_List_Access;
+ Params : Argument_List_Access)
is
- Group : Ada.Strings.Unbounded.Unbounded_String;
- First : Natural;
+ Group : Ada.Strings.Unbounded.Unbounded_String;
+ First : Natural;
use type Ada.Strings.Unbounded.Unbounded_String;
begin
and then Looking_At
(Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all)
then
- Group :=
- Group &
- Result (C)
- (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
- Result (C)'Last);
+ -- If we are still in the same section, group the switches
+ if First = 0
+ or else
+ (Sections (C) = null
+ and then Sections (First) = null)
+ or else
+ (Sections (C) /= null
+ and then Sections (First) /= null
+ and then Sections (C).all = Sections (First).all)
+ then
+ Group :=
+ Group &
+ Result (C)
+ (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
+ Result (C)'Last);
+ if First = 0 then
+ First := C;
+ end if;
- if First = 0 then
+ Free (Result (C));
+ else
+ -- We changed section: we put the grouped switches to the
+ -- first place, on continue with the new section.
+ Result (First) :=
+ new String'
+ (Cmd.Config.Prefixes (P).all &
+ Ada.Strings.Unbounded.To_String (Group));
+ Group :=
+ Ada.Strings.Unbounded.To_Unbounded_String
+ (Result (C)
+ (Result (C)'First + Cmd.Config.Prefixes (P)'Length ..
+ Result (C)'Last));
First := C;
end if;
-
- Free (Result (C));
end if;
end loop;
end loop;
end Alias_Switches;
+ -------------------
+ -- Sort_Sections --
+ -------------------
+
+ procedure Sort_Sections
+ (Line : GNAT.OS_Lib.Argument_List_Access;
+ Sections : GNAT.OS_Lib.Argument_List_Access;
+ Params : GNAT.OS_Lib.Argument_List_Access)
+ is
+ Sections_List : Argument_List_Access :=
+ new Argument_List'(1 .. 1 => null);
+ Found : Boolean;
+ Old_Line : constant Argument_List := Line.all;
+ Old_Sections : constant Argument_List := Sections.all;
+ Old_Params : constant Argument_List := Params.all;
+ Index : Natural;
+
+ begin
+ if Line = null then
+ return;
+ end if;
+
+ -- First construct a list of all sections
+
+ for E in Line'Range loop
+ if Sections (E) /= null then
+ Found := False;
+ for S in Sections_List'Range loop
+ if (Sections_List (S) = null and then Sections (E) = null)
+ or else
+ (Sections_List (S) /= null
+ and then Sections (E) /= null
+ and then Sections_List (S).all = Sections (E).all)
+ then
+ Found := True;
+ exit;
+ end if;
+ end loop;
+
+ if not Found then
+ Append (Sections_List, Sections (E));
+ end if;
+ end if;
+ end loop;
+
+ Index := Line'First;
+
+ for S in Sections_List'Range loop
+ for E in Old_Line'Range loop
+ if (Sections_List (S) = null and then Old_Sections (E) = null)
+ or else
+ (Sections_List (S) /= null
+ and then Old_Sections (E) /= null
+ and then Sections_List (S).all = Old_Sections (E).all)
+ then
+ Line (Index) := Old_Line (E);
+ Sections (Index) := Old_Sections (E);
+ Params (Index) := Old_Params (E);
+ Index := Index + 1;
+ end if;
+ end loop;
+ end loop;
+ end Sort_Sections;
+
-----------
-- Start --
-----------
return;
end if;
+ -- Reorder the expanded line so that sections are grouped
+
+ Sort_Sections (Cmd.Expanded, Cmd.Sections, Cmd.Params);
+
-- Coalesce the switches as much as possible
if not Expanded
Cmd.Coalesce (E) := new String'(Cmd.Expanded (E).all);
end loop;
+ Cmd.Coalesce_Sections := new Argument_List (Cmd.Sections'Range);
+ for E in Cmd.Sections'Range loop
+ if Cmd.Sections (E) = null then
+ Cmd.Coalesce_Sections (E) := null;
+ else
+ Cmd.Coalesce_Sections (E) := new String'(Cmd.Sections (E).all);
+ end if;
+ end loop;
+
-- Not a clone, since we will not modify the parameters anyway
Cmd.Coalesce_Params := Cmd.Params;
Alias_Switches (Cmd, Cmd.Coalesce, Cmd.Params);
- Group_Switches (Cmd, Cmd.Coalesce, Cmd.Params);
+ Group_Switches (Cmd, Cmd.Coalesce, Cmd.Coalesce_Sections, Cmd.Params);
end if;
if Expanded then
- Iter.List := Cmd.Expanded;
- Iter.Params := Cmd.Params;
+ Iter.List := Cmd.Expanded;
+ Iter.Params := Cmd.Params;
+ Iter.Sections := Cmd.Sections;
else
- Iter.List := Cmd.Coalesce;
- Iter.Params := Cmd.Coalesce_Params;
+ Iter.List := Cmd.Coalesce;
+ Iter.Params := Cmd.Coalesce_Params;
+ Iter.Sections := Cmd.Coalesce_Sections;
end if;
if Iter.List = null then
return Iter.List (Iter.Current).all;
end Current_Switch;
+ --------------------
+ -- Is_New_Section --
+ --------------------
+
+ function Is_New_Section (Iter : Command_Line_Iterator) return Boolean is
+ Section : constant String := Current_Section (Iter);
+ begin
+ if Iter.Sections = null then
+ return False;
+ elsif Iter.Current = Iter.Sections'First
+ or else Iter.Sections (Iter.Current - 1) = null
+ then
+ return Section /= "";
+ end if;
+
+ return Section /= Iter.Sections (Iter.Current - 1).all;
+ end Is_New_Section;
+
+ ---------------------
+ -- Current_Section --
+ ---------------------
+
+ function Current_Section (Iter : Command_Line_Iterator) return String is
+ begin
+ if Iter.Sections = null
+ or else Iter.Current > Iter.Sections'Last
+ or else Iter.Sections (Iter.Current) = null
+ then
+ return "";
+ end if;
+
+ return Iter.Sections (Iter.Current).all;
+ end Current_Section;
+
-----------------------
-- Current_Separator --
-----------------------
-- characters whose order is irrelevant. In fact, this package will sort
-- them alphabetically.
+ procedure Define_Section
+ (Config : in out Command_Line_Configuration;
+ Section : String);
+ -- Indicates a new switch section. Every switch belonging to the same
+ -- section are ordered together, preceded by the section. They are placed
+ -- at the end of the command line (as in 'gnatmake somefile.adb -cargs -g')
+
procedure Free (Config : in out Command_Line_Configuration);
-- Free the memory used by Config
-- Command_Line_Iterator (which might be fine depending on your
-- application).
--
+ -- If the command line has sections (such as -bargs -largs -cargs), then
+ -- they should be listed in the Sections parameter (as "-bargs -cargs")
+ --
-- This function can be used to reset Cmd by passing an empty string.
procedure Add_Switch
(Cmd : in out Command_Line;
Switch : String;
Parameter : String := "";
- Separator : Character := ' ');
+ Separator : Character := ' ';
+ Section : String := "");
-- Add a new switch to the command line, and combine/group it with existing
-- switches if possible. Nothing is done if the switch already exists with
-- the same parameter.
-- Separator is the character that goes between the switches and its
-- parameter on the command line. If it is set to ASCII.NUL, then no
-- separator is applied, and they are concatenated
+ --
+ -- If the switch is part of a section, then it should be specified so that
+ -- the switch is correctly placed in the command line, and the section
+ -- added if not already present. For example, to add the -g switch into the
+ -- -cargs section, you need to call (Cmd, "-g", Section => "-cargs")
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
- Remove_All : Boolean := False);
+ Remove_All : Boolean := False;
+ Section : String := "");
-- Remove Switch from the command line, and ungroup existing switches if
-- necessary.
--
--
-- If Remove_All is True, then all matching switches are removed, otherwise
-- only the first matching one is removed.
+ --
+ -- If the switch belongs to a section, then this section should be
+ -- specified: Remove_Switch (Cmd_Line, "-g", Section => "-cargs") called
+ -- on the command line "-g -cargs -g" will result in "-g", while if
+ -- called with (Cmd_Line, "-g") this will result in "-cargs -g".
+ -- If Remove_All is set, then both "-g" will be removed.
procedure Remove_Switch
(Cmd : in out Command_Line;
Switch : String;
- Parameter : String);
+ Parameter : String;
+ Section : String := "");
-- Remove a switch with a specific parameter. If Parameter is the empty
-- string, then only a switch with no parameter will be removed.
-- call to Add_Switch, Remove_Switch or Set_Command_Line.
function Current_Switch (Iter : Command_Line_Iterator) return String;
+ function Is_New_Section (Iter : Command_Line_Iterator) return Boolean;
+ function Current_Section (Iter : Command_Line_Iterator) return String;
function Current_Separator (Iter : Command_Line_Iterator) return String;
function Current_Parameter (Iter : Command_Line_Iterator) return String;
-- Return the current switch and its parameter (or the empty string if
Prefixes : GNAT.OS_Lib.Argument_List_Access;
-- The list of prefixes
+ Sections : GNAT.OS_Lib.Argument_List_Access;
+ -- The list of sections
+
Aliases : GNAT.OS_Lib.Argument_List_Access;
Expansions : GNAT.OS_Lib.Argument_List_Access;
-- The aliases. Both arrays have the same indices
-- Parameter for the corresponding switch in Expanded. The first
-- character is the separator (or ASCII.NUL if there is no separator)
- Coalesce : GNAT.OS_Lib.Argument_List_Access;
- Coalesce_Params : GNAT.OS_Lib.Argument_List_Access;
+ Sections : GNAT.OS_Lib.Argument_List_Access;
+ -- The list of sections
+
+ Coalesce : GNAT.OS_Lib.Argument_List_Access;
+ Coalesce_Params : GNAT.OS_Lib.Argument_List_Access;
+ Coalesce_Sections : GNAT.OS_Lib.Argument_List_Access;
-- Cached version of the command line. This is recomputed every time the
-- command line changes. Switches are grouped as much as possible, and
-- aliases are used to reduce the length of the command line.
type Command_Line_Iterator is record
List : GNAT.OS_Lib.Argument_List_Access;
+ Sections : GNAT.OS_Lib.Argument_List_Access;
Params : GNAT.OS_Lib.Argument_List_Access;
Current : Natural;
end record;
OSDN Git Service
