freepascal.compiler/packages/extra/hermes/list.inc

{
    Free Pascal port of the Hermes C library.
    Copyright (C) 2001-2003  Nikolay Nikolov ([email protected])
    Original C version by Christian Nentwich ([email protected])

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

Type
  TListFreeCallback = Procedure(p : Pointer);
  PHermesListElementStruct = ^THermesListElementStruct;
  THermesListElementStruct = Record
    handle : THermesHandle;
    data : Pointer;
    next : PHermesListElementStruct;
  End;
  PHermesListElement = ^THermesListElement;
  THermesListElement = THermesListElementStruct;
  PHermesList = ^THermesList;
  THermesList = Record
    first, last : PHermesListElement;
  End;

{Function Hermes_ListNew : PHermesList;
Procedure Hermes_ListDestroy(list : PHermesList);
Function Hermes_ListElementNew(handle : THermesHandle) : PHermesListElement;
Procedure Hermes_ListAdd(list : PHermesList; element : PHermesListElement);
Procedure Hermes_ListAddFront(list : PHermesList; element : PHermesListElement);
Function Hermes_ListDeleteElement(list : PHermesList; handle : THermesHandle) : Boolean;
Function Hermes_ListLookup(list : PHermesList;
                           handle : THermesHandle) : PHermesListElement;}

Function Hermes_ListNew : PHermesList;

Var
  tmp : PHermesList;

Begin
{  New(tmp);}
  tmp := malloc(SizeOf(THermesList));
  If tmp = Nil Then
  Begin
    Hermes_ListNew := Nil;
    Exit;
  End;
  tmp^.first := Nil;
  tmp^.last := Nil;
  Hermes_ListNew := tmp;
End;

Procedure Hermes_ListDestroy(list : PHermesList);

Var
  tmp, run : PHermesListElement;

Begin
  If list = Nil Then
    Exit;
  run := list^.first;
  While run <> Nil Do
  Begin
    tmp := run;
    run := run^.next;
    If tmp^.data <> Nil Then
    Begin
      {to do: free(tmp->data)}
      free(tmp^.data);
    End;
    free(tmp);
  End;
  free(list);
  list := Nil;
End;

Function Hermes_ListElementNew(handle : THermesHandle) : PHermesListElement;

Var
  tmp : PHermesListElement;

Begin
  tmp := malloc(SizeOf(THermesListElement));
  If tmp = Nil Then
  Begin
    Hermes_ListElementNew := Nil;
    Exit;
  End;
  tmp^.handle := handle;
  tmp^.next := Nil;
  tmp^.data := Nil;
  Hermes_ListElementNew := tmp;
End;

Procedure Hermes_ListAdd(list : PHermesList; element : PHermesListElement);

Begin
  If (list = Nil) Or (element = Nil) Then
    Exit;
  If list^.first = Nil Then
  Begin
    list^.first := element;
    list^.last := element;
    element^.next := Nil;
    Exit;
  End;
  list^.last^.next := element;
  list^.last := element;
  element^.next := Nil;
End;

Procedure Hermes_ListAddFront(list : PHermesList; element : PHermesListElement);

Begin
  If (list = Nil) Or (element = Nil) Then
    Exit;
  If list^.first = Nil Then
  Begin
    list^.first := element;
    list^.last := element;
    element^.next := Nil;
    Exit;
  End;
  element^.next := list^.first;
  list^.first := element;
End;

Function Hermes_ListDeleteElement(list : PHermesList; handle : THermesHandle; user_free : TListFreeCallback) : Boolean;

Var
  run, previous : PHermesListElement;

Begin
  If list = Nil Then
  Begin
    Hermes_ListDeleteElement := False;
    Exit;
  End;
  previous := Nil;
  run := list^.first;
  While run <> Nil Do
  Begin
    If run^.handle = handle Then
    Begin
      If run = list^.first Then
        list^.first := run^.next
      Else
        previous^.next := run^.next;
      If run = list^.last Then
      Begin
        list^.last := previous;
        If list^.last <> Nil Then
          list^.last^.next := Nil;
      End;
      If run^.data <> Nil Then
      Begin
        If user_free <> Nil Then
        Begin
          user_free(run^.data);
        End;
        free(run^.data);
      End;
      free(run);
      Hermes_ListDeleteElement := True;
      Exit;
    End;
    previous := run;
    run := run^.next;
  End;
  Hermes_ListDeleteElement := False;
End;

Function Hermes_ListDeleteElement(list : PHermesList; handle : THermesHandle) : Boolean;

Begin
  Hermes_ListDeleteElement := Hermes_ListDeleteElement(list, handle, Nil);
End;

Function Hermes_ListLookup(list : PHermesList;
                           handle : THermesHandle) : PHermesListElement;

Var
  run : PHermesListElement;

Begin
  If list = Nil Then
  Begin
    Hermes_ListLookup := Nil;
    Exit;
  End;
  run := list^.first;
  While run <> Nil Do
  Begin
    If run^.handle = handle Then
    Begin
      Hermes_ListLookup := run;
      Exit;
    End;
    run := run^.next;
  End;
  Hermes_ListLookup := Nil;
End;