← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/fpgtk/fpglib.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/extra/fpgtk/fpglib.pp
1
 
{$mode objfpc}{$h+}
2
 
unit FPGlib;
3
 
 
4
 
interface
5
 
 
6
 
uses classes, glib;
7
 
 
8
 
type
9
 
 
10
 
  TLukForEachProcedure = procedure (item : pointer; data : pointer) of object;
11
 
 
12
 
  TLList = class (TList)
13
 
  private
14
 
    FGSList : PGSList;
15
 
    FGList : PGList;
16
 
    FNotUpdating,
17
 
    FClassesChanged,FSlistChanged,FListChanged : Boolean;
18
 
    procedure FreeList;
19
 
    procedure FreeSList;
20
 
    function CreateGList : PGList;
21
 
    function GetTheGtkList : PGList;
22
 
    procedure SetGtkList (Value : PGList);
23
 
    function CreateGSList : PGSList;
24
 
    function GetTheGtkSList : PGSlist;
25
 
    procedure SetGtkSList (Value : PGSList);
26
 
    procedure BuildFromGtkList;
27
 
    procedure BuildFromGtkSList;
28
 
  protected
29
 
    procedure Notify (Ptr: Pointer; Action: TListNotification); override;
30
 
    function GetData (index : integer) : pointer; dynamic;
31
 
    function UngetData (data : pointer) : pointer; dynamic;
32
 
    // GetData needs to give the pointer to the data in the List or SList of GTK
33
 
    // UngetData needs to give the item in this list from the datapointer of GTK
34
 
  public
35
 
    constructor create;
36
 
    destructor destroy; override;
37
 
    function GetGtkList (buffered : boolean) : PGList;
38
 
    function GetGtkSList (buffered : boolean) : PGSlist;
39
 
    procedure BeginUpdate;  // Currently only changes in 1 list are possible
40
 
    procedure EndUpdate;    // without memory leaks and/or errors in the list
41
 
    procedure ForEach (Proc : TLukForEachprocedure; data : pointer);
42
 
    property GtkList : PGList read GetTheGtkList write SetGtkList;
43
 
    property GtkSList : PGSList read GetTheGtkSList write SetGtkSList;
44
 
  end;
45
 
 
46
 
implementation
47
 
 
48
 
{ TLList }
49
 
 
50
 
procedure TLList.FreeList;
51
 
begin
52
 
  if FGList <> null then
53
 
    begin
54
 
    g_list_free (FGList);
55
 
    FGList := null;
56
 
    end;
57
 
end;
58
 
 
59
 
procedure TLList.FreeSList;
60
 
begin
61
 
  if FGSList <> null then
62
 
    begin
63
 
    g_slist_free (FGSList);
64
 
    FGSlist := null;
65
 
    end;
66
 
end;
67
 
 
68
 
procedure TLList.Notify(Ptr: Pointer; Action: TListNotification);
69
 
begin
70
 
  inherited;
71
 
  FClassesChanged := True;
72
 
end;
73
 
 
74
 
constructor TLList.create;
75
 
begin
76
 
  inherited create;
77
 
  FClassesChanged := False;
78
 
  FListChanged := false;
79
 
  FSListChanged := False;
80
 
  FGList := null;
81
 
  FGSList := null;
82
 
  FNotUpdating := True;
83
 
end;
84
 
 
85
 
destructor TLList.destroy;
86
 
begin
87
 
  FreeList;
88
 
  FreeSList;
89
 
  inherited Destroy;
90
 
end;
91
 
 
92
 
function TLList.GetGtkList (buffered : boolean) : PGList;
93
 
begin
94
 
  if buffered then
95
 
    if FClasseschanged then
96
 
      result := CreateGList
97
 
    else if FSListChanged then
98
 
      begin
99
 
      BuildFromGtkSList;
100
 
      result := CreateGList;
101
 
      end
102
 
    else
103
 
      result := FGlist
104
 
  else
105
 
    result := CreateGList;
106
 
end;
107
 
 
108
 
function TLList.GetGtkSList (buffered : boolean) : PGSList;
109
 
begin
110
 
  if buffered then
111
 
    if FClassesChanged then
112
 
      result := CreateGSList
113
 
    else if FListChanged then
114
 
      begin
115
 
      BuildFromGtkList;
116
 
      result := CreateGSList;
117
 
      end
118
 
    else
119
 
      result := FGSlist
120
 
  else
121
 
    result := CreateGSList;
122
 
end;
123
 
 
124
 
function TLList.CreateGList : PGList;
125
 
var r : integer;
126
 
begin
127
 
  FreeList;
128
 
  result := null;
129
 
  for r := pred(count) downto 0 do
130
 
    result := g_list_prepend (result, GetData(r));
131
 
  FGList := result;
132
 
end;
133
 
 
134
 
function TLList.CreateGSList : PGSList;
135
 
var r : integer;
136
 
begin
137
 
  FreeSList;
138
 
  result := null;
139
 
  for r := pred(count) downto 0 do
140
 
    result := g_slist_prepend (result, GetData(r));
141
 
  FGSList := result;
142
 
end;
143
 
 
144
 
function TLList.GetData (index : integer) : pointer;
145
 
begin
146
 
  result := items[index];
147
 
end;
148
 
 
149
 
function TLList.UngetData (data : pointer) : pointer;
150
 
begin
151
 
  result := data
152
 
end;
153
 
 
154
 
function TLList.GetTheGtkList : PGList;
155
 
begin
156
 
  result := GetGtkList (True);
157
 
end;
158
 
 
159
 
procedure TLList.SetGtkList (Value : PGList);
160
 
begin
161
 
  FGList := Value;
162
 
  if FNotUpdating then
163
 
    BuildFromGtkList
164
 
  else
165
 
    FListChanged := True;
166
 
end;
167
 
 
168
 
function TLList.GetTheGtkSList : PGSlist;
169
 
begin
170
 
  result := GetGtkSList (True);
171
 
end;
172
 
 
173
 
procedure TLList.SetGtkSList (Value : PGSList);
174
 
begin
175
 
  FGSlist := Value;
176
 
  if FNotUpdating then
177
 
    BuildFromGtkSList
178
 
  else
179
 
    FSListChanged := True;
180
 
end;
181
 
 
182
 
procedure TLList.BuildFromGtkList;
183
 
var p : PGList;
184
 
begin
185
 
  clear;
186
 
  p := FGList;
187
 
  while p <> null do
188
 
    begin
189
 
    add (UngetData(p^.data));
190
 
    p := p^.Next;
191
 
    end;
192
 
  FListChanged := False;
193
 
  FSListChanged := False;
194
 
  FClassesChanged := False;
195
 
  FreeSList;
196
 
end;
197
 
 
198
 
procedure TLList.BuildFromGtkSList;
199
 
var p :PGSList;
200
 
begin
201
 
  clear;
202
 
  p := FGSList;
203
 
  while p <> null do
204
 
    begin
205
 
    add (UngetData(p^.data));
206
 
    p := p^.Next;
207
 
    end;
208
 
  FListChanged := False;
209
 
  FSListChanged := False;
210
 
  FClassesChanged := False;
211
 
  FreeList;
212
 
end;
213
 
 
214
 
procedure TLList.BeginUpdate;
215
 
begin
216
 
  FNotUpdating := False;
217
 
end;
218
 
 
219
 
procedure TLList.EndUpdate;
220
 
begin
221
 
  FNotUpdating := True;
222
 
  if FlistChanged then
223
 
    BuildFromGtkSList
224
 
  else if FSListChanged then
225
 
    BuildFromGtkSList
226
 
  else if FClassesChanged then
227
 
    begin
228
 
    FreeSList;
229
 
    FreeList;
230
 
    end;
231
 
end;
232
 
 
233
 
procedure TLList.ForEach (Proc : TLukForEachProcedure; data : pointer);
234
 
var r: integer;
235
 
begin
236
 
  for r := 0 to pred(count) do
237
 
    Proc (items[r], data);
238
 
end;
239
 
 
240
 
end.