{
    This file is part of the fpgtk package
    Copyright (c) 1999-2000 by Michael van Canney, Sebastian Guenther
 
    glib like list object.   

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program 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.

 **********************************************************************}

{$mode objfpc}{$h+}
unit FPGlib;

interface

{$IFDEF FPC_DOTTEDUNITS}
uses System.Classes, Api.Gtk1.Glib;
{$ELSE FPC_DOTTEDUNITS}
uses classes, glib;
{$ENDIF FPC_DOTTEDUNITS}

type

  TLukForEachProcedure = procedure (item : pointer; data : pointer) of object;

  TLList = class (TList)
  private
    FGSList : PGSList;
    FGList : PGList;
    FNotUpdating,
    FClassesChanged,FSlistChanged,FListChanged : Boolean;
    procedure FreeList;
    procedure FreeSList;
    function CreateGList : PGList;
    function GetTheGtkList : PGList;
    procedure SetGtkList (Value : PGList);
    function CreateGSList : PGSList;
    function GetTheGtkSList : PGSlist;
    procedure SetGtkSList (Value : PGSList);
    procedure BuildFromGtkList;
    procedure BuildFromGtkSList;
  protected
    procedure Notify (Ptr: Pointer; Action: TListNotification); override;
    function GetData (index : integer) : pointer; dynamic;
    function UngetData (data : pointer) : pointer; dynamic;
    // GetData needs to give the pointer to the data in the List or SList of GTK
    // UngetData needs to give the item in this list from the datapointer of GTK
  public
    constructor create;
    destructor destroy; override;
    function GetGtkList (buffered : boolean) : PGList;
    function GetGtkSList (buffered : boolean) : PGSlist;
    procedure BeginUpdate;  // Currently only changes in 1 list are possible
    procedure EndUpdate;    // without memory leaks and/or errors in the list
    procedure ForEach (Proc : TLukForEachprocedure; data : pointer);
    property GtkList : PGList read GetTheGtkList write SetGtkList;
    property GtkSList : PGSList read GetTheGtkSList write SetGtkSList;
  end;

implementation

{ TLList }

procedure TLList.FreeList;
begin
  if FGList <> null then
    begin
    g_list_free (FGList);
    FGList := null;
    end;
end;

procedure TLList.FreeSList;
begin
  if FGSList <> null then
    begin
    g_slist_free (FGSList);
    FGSlist := null;
    end;
end;

procedure TLList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  inherited;
  FClassesChanged := True;
end;

constructor TLList.create;
begin
  inherited create;
  FClassesChanged := False;
  FListChanged := false;
  FSListChanged := False;
  FGList := null;
  FGSList := null;
  FNotUpdating := True;
end;

destructor TLList.destroy;
begin
  FreeList;
  FreeSList;
  inherited Destroy;
end;

function TLList.GetGtkList (buffered : boolean) : PGList;
begin
  if buffered then
    if FClasseschanged then
      result := CreateGList
    else if FSListChanged then
      begin
      BuildFromGtkSList;
      result := CreateGList;
      end
    else
      result := FGlist
  else
    result := CreateGList;
end;

function TLList.GetGtkSList (buffered : boolean) : PGSList;
begin
  if buffered then
    if FClassesChanged then
      result := CreateGSList
    else if FListChanged then
      begin
      BuildFromGtkList;
      result := CreateGSList;
      end
    else
      result := FGSlist
  else
    result := CreateGSList;
end;

function TLList.CreateGList : PGList;
var r : integer;
begin
  FreeList;
  result := null;
  for r := pred(count) downto 0 do
    result := g_list_prepend (result, GetData(r));
  FGList := result;
end;

function TLList.CreateGSList : PGSList;
var r : integer;
begin
  FreeSList;
  result := null;
  for r := pred(count) downto 0 do
    result := g_slist_prepend (result, GetData(r));
  FGSList := result;
end;

function TLList.GetData (index : integer) : pointer;
begin
  result := items[index];
end;

function TLList.UngetData (data : pointer) : pointer;
begin
  result := data
end;

function TLList.GetTheGtkList : PGList;
begin
  result := GetGtkList (True);
end;

procedure TLList.SetGtkList (Value : PGList);
begin
  FGList := Value;
  if FNotUpdating then
    BuildFromGtkList
  else
    FListChanged := True;
end;

function TLList.GetTheGtkSList : PGSlist;
begin
  result := GetGtkSList (True);
end;

procedure TLList.SetGtkSList (Value : PGSList);
begin
  FGSlist := Value;
  if FNotUpdating then
    BuildFromGtkSList
  else
    FSListChanged := True;
end;

procedure TLList.BuildFromGtkList;
var p : PGList;
begin
  clear;
  p := FGList;
  while p <> null do
    begin
    add (UngetData(p^.data));
    p := p^.Next;
    end;
  FListChanged := False;
  FSListChanged := False;
  FClassesChanged := False;
  FreeSList;
end;

procedure TLList.BuildFromGtkSList;
var p :PGSList;
begin
  clear;
  p := FGSList;
  while p <> null do
    begin
    add (UngetData(p^.data));
    p := p^.Next;
    end;
  FListChanged := False;
  FSListChanged := False;
  FClassesChanged := False;
  FreeList;
end;

procedure TLList.BeginUpdate;
begin
  FNotUpdating := False;
end;

procedure TLList.EndUpdate;
begin
  FNotUpdating := True;
  if FlistChanged then
    BuildFromGtkSList
  else if FSListChanged then
    BuildFromGtkSList
  else if FClassesChanged then
    begin
    FreeSList;
    FreeList;
    end;
end;

procedure TLList.ForEach (Proc : TLukForEachProcedure; data : pointer);
var r: integer;
begin
  for r := 0 to pred(count) do
    Proc (items[r], data);
end;

end.
