Still open for suggestions :-)

["Frank" <franjoe@frisurf.no>]

Hi!

I'm still stuck on this issue. Have studied the
http://www.vaxxine.com/pegasoft/homes/11.html
but haven't found examples that quite fit my situation.

Now choose to supply the full source code for the headace.
Is there some compile options I must use? or could I have a invalid
installation??


Frank

package JxT_List is

   type List_t is tagged private;
   type List_p is access all List_t'class;

   type Element_t is tagged private;
   type Element_p is access all Element_t'class;

   procedure Add (Element : access Element_t'Class;
                  List : List_p);
   procedure Remove (Element : access Element_t'Class);

   function Get_First (List : List_p) return Element_p;
   function Get_Next (Element : access Element_t'Class) return Element_p;

   function Get_List (Element : access Element_t'Class) return List_p;

private

   --
   --  Doubly-linked...
   --
   type Element_t is tagged record
      Next : Element_p;
      Prev : Element_p;
      List : List_p;
   end record;

   --
   --  With head and tail pointers.  Non-circular.
   --
   type List_t is tagged record
      Head : Element_p := null;
      Tail : Element_p := null;
      Num_Elems : integer := 0;
   end record;

end JxT_List;

package body JxT_List is

   ----------------------------
   -- Add                    --
   ----------------------------
   --  Public
   --  Adds an element to a list.
   --
   procedure Add (Element : access Element_t'Class;
                  List : List_p) is
   begin
      if (Element = null) then
         null;
      else
         if (Element.List /= null) then
            Remove (Element);
         end if;
         if (List.Num_Elems = 0) then
            List.Head := Element;
            List.Tail := Element;
            Element.Next := null;
            Element.Prev := null;
         else
            List.Tail.Next := Element;
            Element.Next := null;
            Element.Prev := List.Tail;
            List.Tail := Element;
         end if;
         List.Num_Elems := List.Num_Elems + 1;
         Element.List := List;
      end if;
   end Add;

   ----------------------------
   -- Remove                 --
   ----------------------------
   --  Public
   --  Removes an element from it's list.
   --
   procedure Remove (Element : access Element_t'Class) is
      List : List_p;
   begin
      if Element = null then
         return;
      elsif Element.List = null then
         return;
      else  -- now do the real delete
         List := Element.List;
         if (List.Num_Elems = 1) then        -- only element
            List.Head := null;
            List.Tail := null;
         elsif (List.Head = Element) then    -- first element
            List.Head := Element.Next;
            List.Head.Prev := null;
         elsif (List.Tail = Element) then    -- last element
            List.Tail := Element.Prev;
            List.Tail.Next := null;
         else                                -- somewhere in middle
            Element.Prev.Next := Element.Next;
            Element.Next.Prev := Element.Prev;
         end if;
         List.Num_Elems := List.Num_Elems - 1;
         Element.Next := null;
         Element.Prev := null;
         Element.List := null;
      end if;
   end Remove;

   ----------------------------
   -- Get_Next               --
   ----------------------------
   --  Public
   --  Given an element, returns the next element in whatever
   --  list the element is in.
   --
   function Get_Next (Element : access Element_t'Class) return Element_p is
   begin
      if Element = null then
         return null;
      else
         return Element.Next;
      end if;
   end Get_Next;

   ----------------------------
   -- Get_First              --
   ----------------------------
   --  Public
   --  Returns pntr to first element in a list
   --
   function Get_First (List : List_p) return Element_p is
   begin
      return List.Head;
   end Get_First;

   ----------------------------
   -- Get_List               --
   ----------------------------
   --  Public
   --  Returns pntr to List that this element is in;
   --      null if not in a list.
   --
   function Get_List (Element : access Element_t'Class) return List_p is
   begin
      return Element.List;
   end Get_List;

end JxT_List;