with GNAT.HTable;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Namet; use Namet;
with Prj.Com; use Prj.Com;
with Stringt; use Stringt;
with Types; use Types;
package body Prj.Ext is
package Htable is new GNAT.HTable.Simple_HTable
(Header_Num => Header_Num,
Element => String_Id,
No_Element => No_String,
Key => Name_Id,
Hash => Hash,
Equal => "=");
procedure Add
(External_Name : String;
Value : String)
is
The_Key : Name_Id;
The_Value : String_Id;
begin
Start_String;
Store_String_Chars (Value);
The_Value := End_String;
Name_Len := External_Name'Length;
Name_Buffer (1 .. Name_Len) := External_Name;
The_Key := Name_Find;
Htable.Set (The_Key, The_Value);
end Add;
function Check (Declaration : String) return Boolean is
begin
for Equal_Pos in Declaration'Range loop
if Declaration (Equal_Pos) = '=' then
exit when Equal_Pos = Declaration'First;
exit when Equal_Pos = Declaration'Last;
Add
(External_Name =>
Declaration (Declaration'First .. Equal_Pos - 1),
Value =>
Declaration (Equal_Pos + 1 .. Declaration'Last));
return True;
end if;
end loop;
return False;
end Check;
function Value_Of
(External_Name : Name_Id;
With_Default : String_Id := No_String)
return String_Id
is
The_Value : String_Id;
begin
The_Value := Htable.Get (External_Name);
if The_Value /= No_String then
return The_Value;
end if;
declare
Env_Value : constant String_Access :=
Getenv (Get_Name_String (External_Name));
begin
if Env_Value /= null and then Env_Value'Length > 0 then
Start_String;
Store_String_Chars (Env_Value.all);
The_Value := End_String;
Htable.Set (External_Name, The_Value);
return The_Value;
else
return With_Default;
end if;
end;
end Value_Of;
end Prj.Ext;