svn -r 518:520 $svn_public/branches/agpl-20060706-manzanera

Merged to trunk

M    agpl-htn-tasks.adb
M    agpl-htn-tasks.ads
M    agpl.gpr
M    agpl-htn-plan.adb
M    agpl-htn-plan.ads

agpl-htn-plan.adb

@@ -666,6 +666,22 @@ package body Agpl.Htn.Plan is
       Plan_Node.Build_Index (This.Tasks, This.Index);
    end Build_Index;
 
+   procedure Clear (This : in out Object) is
+   begin
+      This.Finalize;
+      This.Index.Clear;
+      This.Methods.Clear;
+   end Clear;
+
+   --------------
+   -- Contains --
+   --------------
+
+   function Contains (This : in Object; Id : in Tasks.Task_Id) return Boolean is
+   begin
+      return This.Index.Contains (Id);
+   end Contains;
+
    --------------------
    -- Copy_But_Tasks --
    --------------------

agpl-htn-plan.ads

@@ -88,6 +88,9 @@ package Agpl.Htn.Plan is
       Pending        : in     Boolean := False)
       return                  Htn.Tasks.Lists.List;
 
+   procedure Clear (This : in out Object);
+   --  Delete everything
+
    procedure Expand (This    : in Object;
                      Results : not null access procedure (Found : in Object));
    --  Will produce eventually all valid expansions of the plan.
@@ -99,6 +102,9 @@ package Agpl.Htn.Plan is
    --  and each child of this OR node is a fully expanded plan.
    --  Will return an empty plan if no valid expansions are found.
 
+   function Contains (This : in Object; Id : in Tasks.Task_Id) return Boolean;
+   --  Say if a particular task is somewhere in the plan
+
    function Get_Node
      (This : in Object;
       Id   : in Tasks.Task_Id) return Subplan;

agpl-htn-tasks.adb

@@ -66,6 +66,38 @@ package body Agpl.Htn.Tasks is
       end if;
    end Get_Id;
 
+   ------------------
+   -- Get_Property --
+   ------------------
+
+   function Get_Property (This : in Object;
+                          Key  : in String;
+                          Def  : in String := "") return String
+   is
+      use Containers.String_String_Maps;
+      I : constant Cursor := This.Properties.Find (Key);
+   begin
+      if Has_Element (I) then
+         return Element (I);
+      elsif Def /= "" then
+         return Def;
+      else
+         raise Constraint_Error;
+      end if;
+   end Get_Property;
+
+   ------------------
+   -- Set_Property --
+   ------------------
+
+   procedure Set_Property (This : in out Object;
+                           Key  : in     String;
+                           Val  : in     String)
+   is
+   begin
+      This.Properties.Include (Key, Val);
+   end Set_Property;
+
    ---------------
    -- To_String --
    ---------------

agpl-htn-tasks.ads

@@ -31,6 +31,8 @@
 --  decomposed in other tasks (either compound and/or primitive) until all
 --  tasks are primitive. At this point we say we have a valid Plan.
 
+private with Agpl.Containers.String_String_Maps;
+
 with Ada.Finalization;
 with Ada.Streams;
 
@@ -58,6 +60,15 @@ package Agpl.Htn.Tasks is
 
    function Is_Primitive (This : in Object) return Boolean is abstract;
 
+   function Get_Property (This : in Object;
+                          Key  : in String;
+                          Def  : in String := "") return String;
+   --  If the default value is "" and the property doesnt exist, raise C_E.
+
+   procedure Set_Property (This : in out Object;
+                           Key  : in     String;
+                           Val  : in     String);
+
    function To_String (This : in Object) return String;
    --  Human readable task description.
    --  This default returns "Task #id".
@@ -95,7 +106,8 @@ private
    No_Task : constant Task_Id := 0;
 
    type Object is abstract new Ada.Finalization.Controlled with record
-      Id : Task_Id := No_Task;
+      Id         : Task_Id := No_Task;
+      Properties : Containers.String_String_Maps.Map;
    end record;
 
    procedure Initialize (This : in out Object);

agpl.gpr

@@ -45,7 +45,7 @@ project Agpl is
 
       for Default_Switches ("c") use ("-g");
       for Default_Switches ("ada") use 
-         ("-g", "-s", "-gnatf", "-gnat05", "-gnatwcfjklmopruvz", "-gnatyacehikn", "-gnatQ");
+         ("-g", "-s", "-gnatf", "-gnat05", "-gnatwcfjklmopruvz", "-gnatyacehikn", "-gnatqQ");
 
       case Build is