mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-07-25 15:46:24 +02:00
241 lines
4.9 KiB
ObjectPascal
241 lines
4.9 KiB
ObjectPascal
{$mode objfpc}{$h+}
|
|
unit FPGlib;
|
|
|
|
interface
|
|
|
|
uses classes, glib;
|
|
|
|
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.
|