From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-0.3 required=5.0 tests=BAYES_00,FREEMAIL_FROM,
	REPLYTO_WITHOUT_TO_CC autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,dae16e5441382930
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2001-03-07 14:04:07 PST
Path: 
 supernews.google.com!sn-xit-03!supernews.com!freenix!jussieu.fr!opentransit.net!news.tele.dk!148.122.208.68!news2.oke.nextra.no!nextra.com!news3.oke.nextra.no.POSTED!not-for-mail
Reply-To: "Frank" <franjoe@frisurf.no>
From: "Frank" <franjoe@frisurf.no>
Newsgroups: comp.lang.ada
References: <wKxo6.7148$t21.173574@news3.oke.nextra.no>
Subject: Still open for suggestions :-)
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 5.00.2615.200
X-MimeOLE: Produced By Microsoft MimeOLE V5.00.2615.200
Message-ID: <jcyp6.9881$t21.267623@news3.oke.nextra.no>
Date: Wed, 7 Mar 2001 22:55:58 +0100
NNTP-Posting-Host: 130.67.135.101
X-Complaints-To: news-abuse@nextra.no
X-Trace: news3.oke.nextra.no 984002447 130.67.135.101 (Wed,
 07 Mar 2001 23:00:47 MET)
NNTP-Posting-Date: Wed, 07 Mar 2001 23:00:47 MET
Organization: Nextra Public Access
Xref: supernews.google.com comp.lang.ada:5524
Date: 2001-03-07T22:55:58+01:00
List-Id: <comp.lang.ada>

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;