1{%MainUnit gtkint.pp}
2{******************************************************************************
3                                 gtklistsl.inc
4                 TGtkListStringList and TGtkCListStringList
5
6 ******************************************************************************
7
8 *****************************************************************************
9  This file is part of the Lazarus Component Library (LCL)
10
11  See the file COPYING.modifiedLGPL.txt, included in this distribution,
12  for details about the license.
13 *****************************************************************************
14}
15
16
17{*************************************************************
18                      Default compare functions
19*************************************************************}
20
21{function DefaultCompareFunc(a, b : gpointer) : gint; cdecl;
22var AStr, BStr : PChar;
23begin
24  gtk_label_get(PGtkLabel(PGtkBin(a)^.child), @AStr);
25  gtk_label_get(PGtkLabel(PGtkBin(b)^.child), @BStr);
26  Result:= strcomp(AStr, BStr);
27end;}
28
29{function DefaultCheckCompareFunc(a, b : gpointer) : gint; cdecl;
30var AStr, BStr : PChar;
31begin
32  gtk_label_get(PPointer(PGTKBox(PGtkBin(a)^.child)^.Children^.Next^.Data)^, @AStr);
33  gtk_label_get(PPointer(PGTKBox(PGtkBin(b)^.child)^.Children^.Next^.Data)^, @BStr);
34  Result:= strcomp(AStr, BStr);
35end;}
36
37{------------------------------------------------------------------------------
38  function gtkListItemDrawCB(Widget: PGtkWidget; area: PGDKRectangle;
39    data: gPointer) : GBoolean; cdecl;
40
41  Handler for draw events of every item in a TGtkListStringList.
42------------------------------------------------------------------------------}
43function gtkListItemDrawAfterCB(Widget: PGtkWidget; {%H-}area: PGDKRectangle;
44  data: gPointer): GBoolean; cdecl;
45var
46  Msg: TLMDrawListItem;
47  ItemIndex: integer;
48  GtkList: PGtkList;
49  AreaRect: TRect;
50  State: TOwnerDrawState;
51  LCLList: TGtkListStringList;
52begin
53  Result:=true;
54
55  //DebugLn('gtkListItemDrawCB ');
56
57  // get context
58  GtkList:=PGtkList(g_object_get_data(PGObject(Data),GtkListItemGtkListTag));
59  if GtkList=nil then
60    RaiseGDBException('gtkListItemDrawAfterCB GtkList=nil');
61  LCLList:=TGtkListStringList(g_object_get_data(PGObject(Data),
62                              GtkListItemLCLListTag));
63  if LCLList=nil then
64    RaiseGDBException('gtkListItemDrawAfterCB LCLList=nil');
65  if [csDestroying,csLoading]*LCLList.Owner.ComponentState<>[] then exit;
66
67  // only owner draw lists are interested in drawing items themselves.
68  if LclList.Owner is TCustomListbox then
69    if TCustomListbox(LCLList.Owner).Style = lbStandard then
70      exit;
71  if LclList.Owner is TCustomCombobox then
72    if not TCustomCombobox(LclList.Owner).Style.IsOwnerDrawn then
73      exit;
74
75  // get itemindex and area
76  ItemIndex:=g_list_index(GtkList^.children,Data);
77  with Widget^.allocation do begin
78    AreaRect:=Bounds(x,y,width,height);
79  end;
80
81  // collect state flags
82  State:=[odBackgroundPainted];
83  if g_list_index(GtkList^.selection,Widget)>=0 then
84    Include(State,odSelected);
85  if not GTK_WIDGET_SENSITIVE(Widget) then
86    Include(State,odInactive);
87  if GTK_WIDGET_HAS_DEFAULT(Widget) then
88    Include(State,odDefault);
89  if GTK_WIDGET_HAS_FOCUS(Widget) then
90    Include(State,odFocused);
91
92  // create message and deliver
93  FillChar(Msg{%H-},SizeOf(Msg),0);
94  Msg.Msg:=LM_DrawListItem;
95  New(Msg.DrawListItemStruct);
96  try
97    FillChar(Msg.DrawListItemStruct^,SizeOf(TDrawListItemStruct),0);
98    with Msg.DrawListItemStruct^ do begin
99      ItemID:=ItemIndex;
100      Area:=AreaRect;
101      DC:=GetDC(HWnd({%H-}PtrUInt(Widget)));
102      ItemState:=State;
103    end;
104    //DebugLn('gtkListItemDrawAfterCB ',DbgSName(LCLList.Owner),' Widget=',DbgS(Widget));
105    Result := DeliverMessage(LCLList.Owner, Msg)=0;
106    ReleaseDC(HWnd({%H-}PtrUInt(Widget)),Msg.DrawListItemStruct^.DC);
107  finally
108    Dispose(Msg.DrawListItemStruct);
109  end;
110end;
111
112{------------------------------------------------------------------------------
113function gtkListItemExposeEvent(Widget: PGtkWidget;
114  Event : PGdkEventExpose; data: gPointer): GBoolean; cdecl;
115
116  GTK2 helper for drawing every item in a TGtkListStringList.
117------------------------------------------------------------------------------}
118function gtkListItemExposeEvent(Widget: PGtkWidget;
119  Event : PGdkEventExpose; data: gPointer): GBoolean; cdecl;
120begin
121  Result := gtkListItemDrawAfterCB(Widget, @Event^.Area, data);
122end;
123
124{------------------------------------------------------------------------------
125  function gtkListItemToggledCB(Widget: PGtkWidget; Data: gPointer): GBoolean; cdecl;
126
127  Called when a toggle button has change in a
128  TGtkListStringList (TCustomCheckListBox).
129------------------------------------------------------------------------------}
130function gtkListItemToggledCB(Widget: PGtkWidget; Data: gPointer): GBoolean; cdecl;
131var
132  GtkList: PGtkList;
133  LCLList: TGtkListStringList;
134  Mess: TLMessage;
135  ItemIndex: LongInt;
136begin
137  Result:=true;
138
139  //DebugLn('gtkListItemDrawCB ');
140
141  // get context
142  GtkList:=PGtkList(g_object_get_data(PGObject(Data),GtkListItemGtkListTag));
143  if GtkList=nil then
144    RaiseGDBException('gtkListItemToggledCB GtkList=nil');
145  LCLList:=TGtkListStringList(g_object_get_data(PGObject(Data),
146                              GtkListItemLCLListTag));
147  if LCLList=nil then
148    RaiseGDBException('gtkListItemToggledCB LCLList=nil');
149  if [csDestroying,csLoading]*LCLList.Owner.ComponentState<>[] then exit;
150
151  // get itemindex and area
152  ItemIndex:=g_list_index(GtkList^.children,Data);
153
154  if LockOnChange({%H-}PgtkObject(LCLList.Owner.Handle),0) > 0 then Exit;
155
156  if GtkWidgetIsA(Widget,gtk_toggle_button_get_type) then begin
157    g_object_set_data(PGObject(Widget), 'Grayed', nil);
158  end;
159
160  Mess.Msg := LM_CHANGED;
161  Mess.Result := 0;
162  Mess.WParam := ItemIndex;
163  //DebugLn(['gtkListItemToggledCB ',ItemIndex]);
164  DeliverMessage(LCLList.Owner, Mess);
165end;
166
167procedure GtkListItemSelectAfterCB(Widget: PGtkWidget; data: gpointer); cdecl;
168
169  procedure RaiseGTKListNotFound;
170  var
171    s: String;
172    ChildWidget: PGtkWidget;
173    BoxWidget: PGtkBox;
174    LabelWidget: PGtkLabel;
175    LabelText: PChar;
176  begin
177    s:='gtkListItemSelectAfterCB GtkList=nil li='+dbgs(Widget);
178    ChildWidget:=PGtkBin(Widget)^.child;
179    LabelWidget:=nil;
180    if GtkWidgetIsA(ChildWidget,gtk_label_get_type) then
181      LabelWidget:=PGTKLabel(ChildWidget)
182    else if GtkWidgetIsA(ChildWidget,gtk_box_get_type) then begin
183      BoxWidget:=PGTKBox(ChildWidget);
184      if (BoxWidget^.Children<>nil)
185      and (BoxWidget^.Children^.Next<>nil) then begin
186        LabelWidget:=BoxWidget^.Children^.Next^.Data;
187        if not GtkWidgetIsA(PGtkWidget(LabelWidget),gtk_label_get_type) then
188          LabelWidget:=nil;
189      end;
190    end;
191    if LabelWidget<>nil then begin
192      LabelText:=nil;
193      gtk_label_get(LabelWidget, @LabelText);
194      s:=s+' Text="'+DbgStr(StrPas(LabelText))+'"';
195    end;
196    RaiseGDBException(s);
197  end;
198
199var
200  GtkList: PGtkList;
201  LCLList: TGtkListStringList;
202  //ItemIndex: LongInt;
203  Mess: TLMessage;
204begin
205  {$IFDEF EventTrace}
206  Debugln('gtkListItemSelectAfterCB');
207  {$ENDIF}
208  // get context
209  GtkList:=PGtkList(g_object_get_data(PGObject(Data),GtkListItemGtkListTag));
210  if GtkList=nil then
211    RaiseGTKListNotFound;
212  LCLList:=TGtkListStringList(g_object_get_data(PGObject(Data),
213                              GtkListItemLCLListTag));
214  if LCLList=nil then
215    RaiseGDBException('gtkListItemSelectAfterCB LCLList=nil');
216  if [csDestroying,csLoading]*LCLList.Owner.ComponentState<>[] then exit;
217
218  // get itemindex and area
219  //ItemIndex:=g_list_index(GtkList^.children,Data);
220
221  if LockOnChange({%H-}PGtkObject(LCLList.Owner.Handle),0) > 0 then Exit;
222
223  Mess.Msg := LM_SELCHANGE;
224  Mess.Result := 0;
225  DeliverMessage(LCLList.Owner, Mess);
226end;
227
228{*************************************************************}
229{                      TGtkListStringList methods             }
230{*************************************************************}
231
232{------------------------------------------------------------------------------
233  Method: TGtkListStringList.Create
234  Params:
235  Returns:
236
237 ------------------------------------------------------------------------------}
238constructor TGtkListStringList.Create(List: PGtkList; TheOwner: TWinControl;
239  const AWithCheckBox: Boolean);
240begin
241  inherited Create;
242  if List = nil then RaiseGDBException(
243    'TGtkListStringList.Create Unspecified list widget');
244  FGtkList:= List;
245  if TheOwner = nil then RaiseGDBException(
246    'TGtkListStringList.Create Unspecified owner');
247  FOwner:=TheOwner;
248  FWithCheckBox := AWithCheckBox;
249  //DebugLn('TGtkListStringList.Create Self=',DbgS(Self),' List=',DbgS(List),' Owner=',DbgS(Owner));
250  Include(FStates,glsItemCacheNeedsUpdate);
251  ConnectAllCallbacks;
252  {$IFDEF CheckGtkList}
253  ConsistencyCheck;
254  {$ENDIF}
255end;
256
257destructor TGtkListStringList.Destroy;
258begin
259  // don't destroy the widgets
260  RemoveAllCallbacks;
261  ReAllocMem(FCachedItems,0);
262  FCachedItems:=nil;
263  FCachedCount:=0;
264  FCachedCapacity:=0;
265  //DebugLn('TGtkListStringList.Destroy Self=',DbgS(Self),' List=',DbgS(FGtkList),' Owner=',DbgS(Owner));
266  inherited Destroy;
267end;
268
269function TGtkListStringList.Add(const S: string): Integer;
270begin
271  if FSorted then begin
272    Result := GetInsertPosition(S);
273    Insert(Count,S);
274  end else begin
275    Result:=Count;
276    Insert(Result,S);
277  end;
278end;
279
280{------------------------------------------------------------------------------
281  Method: TGtkListStringList.SetSorted
282  Params:
283  Returns:
284
285 ------------------------------------------------------------------------------}
286procedure TGtkListStringList.SetSorted(Val : boolean);
287begin
288  if Val <> FSorted then begin
289    FSorted:= Val;
290    if FSorted then Sort;
291  end;
292end;
293
294procedure TGtkListStringList.CheckForInvalidFocus;
295var
296  Window: PGtkWindow;
297begin
298  { This procedure works round a gtk problem - a deleted item may have the focus
299    according to an enclosing window, but the enclosing window does not notice
300    that the item has gone. }
301  Window := PGtkWindow(gtk_widget_get_ancestor(PGtkWidget(FGtkList),
302                                               gtk_window_get_type));
303  if (Window <> nil) and (Window^.focus_widget <> nil)
304     and (gtk_widget_get_ancestor(Window^.focus_widget, gtk_list_get_type)
305          = PGtkWidget(FGtkList))
306  then
307    Window^.focus_widget := nil;
308end;
309
310{------------------------------------------------------------------------------
311  procedure TGtkListStringList.ConnectItemCallbacks(Index: integer);
312
313 ------------------------------------------------------------------------------}
314procedure TGtkListStringList.ConnectItemCallbacks(Index: integer);
315var
316  ListItem: PGtkListItem;
317begin
318  UpdateItemCache;
319  {$IFDEF EventTrace}
320  Debugln( 'connect ',strings[index]);
321  {$ENDIF}
322  ListItem:=FCachedItems[Index];
323  ConnectItemCallbacks(ListItem);
324end;
325
326{------------------------------------------------------------------------------
327  procedure TGtkListStringList.ConnectItemCallbacks(Li: PGtkListItem);
328
329 ------------------------------------------------------------------------------}
330procedure TGtkListStringList.ConnectItemCallbacks(Li: PGtkListItem);
331var
332  ChildWidget: Pointer;
333begin
334  {$IFDEF EventTrace}
335   Debugln('connect itemCallback');
336  {$ENDIF}
337  g_object_set_data(PGObject(li),GtkListItemLCLListTag,Self);
338  g_object_set_data(PGObject(li),GtkListItemGtkListTag,FGtkList);
339  //DebugLn('TGtkListStringList.ConnectItemCallbacks Self=',DbgS(Self),
340  //' GtkList=',DbgS(FGtkList),
341  //' Owner=',DbgS(Owner),'=',Owner.ClassName,
342  //' LI=',DbgS(LI),
343  //' ');
344  //DebugLn(['TGtkListStringList.ConnectItemCallbacks ',DbgSName(Owner)]);
345  g_signal_connect_after(G_OBJECT(li), 'expose_event',
346                         G_CALLBACK(@gtkListItemExposeEvent), li);
347  if FWithCheckBox then begin
348    ChildWidget := PPointer(PGTKBox(PGtkBin(Li)^.child)^.Children^.Data)^;
349    g_signal_connect_after(G_OBJECT(ChildWidget), 'toggled',
350                           G_CALLBACK(@gtkListItemToggledCB), li);
351  end;
352end;
353
354{------------------------------------------------------------------------------
355  procedure TGtkListStringList.ConnectAllCallbacks;
356 ------------------------------------------------------------------------------}
357procedure TGtkListStringList.ConnectAllCallbacks;
358var
359  i: Integer;
360begin
361  BeginUpdate;
362  UpdateItemCache;
363  i := FCachedCount - 1;
364  while i >= 0 do
365  begin
366    {$IFDEF EventTrace}
367    DebugLn('connect ',strings[i]);
368    {$ENDIF}
369    ConnectItemCallbacks(FCachedItems[i]);
370    Dec(i);
371  end;
372  EndUpdate;
373end;
374
375{------------------------------------------------------------------------------
376  procedure TGtkListStringList.RemoveItemCallbacks(Index: integer);
377
378 ------------------------------------------------------------------------------}
379procedure TGtkListStringList.RemoveItemCallbacks(Index: integer);
380begin
381  UpdateItemCache;
382  RemoveItemCallbacks(FCachedItems[Index]);
383end;
384
385procedure TGtkListStringList.RemoveItemCallbacks(AItem: PGtkListItem);
386var
387  ChildWidget: Pointer;
388begin
389  {$IFDEF EventTrace}
390   Debugln('connect itemCallback');
391  {$ENDIF}
392  g_object_set_data(PGObject(AItem), GtkListItemLCLListTag, nil);
393  g_object_set_data(PGObject(AItem), GtkListItemGtkListTag, nil);
394
395  g_signal_handlers_disconnect_by_func(
396    G_OBJECT(AItem), G_CALLBACK(@gtkListItemExposeEvent), AItem);
397  if FWithCheckBox
398  then begin
399    ChildWidget := PPointer(PGTKBox(PGtkBin(AItem)^.child)^.Children^.Data)^;
400    gtk_signal_disconnect_by_func(
401      PGtkObject(ChildWidget), TGTKSignalFunc(@gtkListItemToggledCB), AItem);
402    FreeWidgetInfo(ChildWidget);
403  end;
404end;
405
406{------------------------------------------------------------------------------
407  procedure TGtkListStringList.RemoveAllCallbacks;
408
409 ------------------------------------------------------------------------------}
410procedure TGtkListStringList.RemoveAllCallbacks;
411var
412  i: integer;
413begin
414  BeginUpdate;
415  UpdateItemCache;
416  i := FCachedCount - 1;
417  while i >= 0 do
418  begin
419    RemoveItemCallbacks(FCachedItems[i]);
420    Dec(i);
421  end;
422  EndUpdate;
423end;
424
425procedure TGtkListStringList.UpdateItemCache;
426var
427  CurListItem: PGList;
428  i: integer;
429begin
430  if not (glsItemCacheNeedsUpdate in FStates) then exit;
431
432  {$IFDEF DebugLCLComponents}
433  // if items were removed => mark them as destroyed
434  for i:=0 to FCachedCount-1 do begin
435    if (FGtkList=nil)
436    or (g_list_find(FGtkList^.children,FCachedItems[i])=nil) then begin
437      if DebugGtkWidgets.IsCreated(FCachedItems[i]) then begin
438        DebugLn(['TGtkListStringList.UpdateItemCache item vanished: ',i]);
439        DebugGtkWidgets.MarkDestroyed(FCachedItems[i]);
440      end;
441    end;
442  end;
443  {$ENDIF}
444
445  if (FGtkList<>nil) and (FGtkList^.children<>nil) then
446    FCachedCount:=g_list_length(FGtkList^.children)
447  else
448    FCachedCount:=0;
449  if FCachedCount=0 then
450    FCachedCapacity:=0
451  else begin
452    FCachedCapacity:=1;
453    while FCachedCapacity<FCachedCount do
454      FCachedCapacity:=FCachedCapacity shl 1;
455    FCachedCapacity:=FCachedCapacity shl 1;
456  end;
457  ReAllocMem(FCachedItems,SizeOf(PGtkListItem)*FCachedCapacity);
458  if FGtkList<>nil then begin
459    CurListItem:=FGtkList^.children;
460    i:=0;
461    while CurListItem<>nil do begin
462      FCachedItems[i]:=PGtkListItem(CurListItem^.Data);
463      {$IFDEF DebugLCLComponents}
464      if not DebugGtkWidgets.IsCreated(PGtkListItem(CurListItem^.Data)) then
465      begin
466        DebugLn(['TGtkListStringList.UpdateItemCache unknown item ',i,' ',DbgSName(Owner)]);
467        DumpStack;
468      end;
469      {$ENDIF}
470      inc(i);
471      CurListItem:=CurListItem^.Next;
472    end;
473  end;
474  Exclude(FStates,glsItemCacheNeedsUpdate);
475end;
476
477function TGtkListStringList.CacheValid: boolean;
478begin
479  Result:=not (glsItemCacheNeedsUpdate in FStates);
480end;
481
482procedure TGtkListStringList.PutObject(Index: Integer; AnObject: TObject);
483var
484  ListItem : PGtkListItem;
485begin
486  //DebugLn('[TGtkListStringList.PutObject] Index=',Index,' Count=',Count);
487  ListItem:=GetListItem(Index);
488  if ListItem <> nil then
489    g_object_set_data(PGObject(ListItem),'LCLStringsObject',AnObject);
490end;
491
492{------------------------------------------------------------------------------
493  Method: TGtkListStringList.Sort
494  Params:
495  Returns:
496
497 ------------------------------------------------------------------------------}
498procedure TGtkListStringList.Sort;
499var
500  sl: TStringList;
501begin
502  BeginUpdate;
503  // sort internally (sorting in the widget would be slow and unpretty ;)
504  sl:=TStringList.Create;
505  sl.Assign(Self);
506  sl.Sort; // currently this is quicksort ->
507             // Disadvantages: - worst case on sorted list
508             //                - not keeping order
509             // ToDo: replace by mergesort and add customsort
510             //       remember selected items
511  Assign(sl);
512  sl.Free;
513  EndUpdate;
514end;
515
516function TGtkListStringList.IsEqual(List: TStrings;
517  CompareObjects: boolean): boolean;
518var
519  i, Cnt: integer;
520  CmpList: TStringList;
521begin
522  if List=Self then begin
523    Result:=true;
524    exit;
525  end;
526  Result:=false;
527  if List=nil then exit;
528  Cnt:=Count;
529  if (Cnt<>List.Count) then exit;
530  BeginUpdate;
531  CmpList:=TStringList.Create;
532  try
533    CmpList.Assign(List);
534    CmpList.Sorted:=FSorted;
535    for i:=0 to Cnt-1 do begin
536      if (Strings[i]<>CmpList[i])
537      or (CompareObjects and (Objects[i]<>CmpList.Objects[i])) then
538        exit;
539    end;
540  finally
541    CmpList.Free;
542    EndUpdate;
543  end;
544  Result:=true;
545end;
546
547procedure TGtkListStringList.BeginUpdate;
548begin
549  //NOTE: in TComboBox, event handling is done inside the 'changed' event
550  //  of the entry widget. Here we are locking the main combo widget.
551  //  Currently, there's no know bug origined from this flaw.
552  inc(FUpdateCount);
553  if (FUpdateCount=1) and (Owner<>nil) and (Owner.HandleAllocated) then
554    LockOnChange({%H-}PGtkObject(Owner.Handle),+1);
555end;
556
557procedure TGtkListStringList.EndUpdate;
558begin
559  dec(FUpdateCount);
560  if (FUpdateCount=0) then begin
561    if (Owner<>nil) and (Owner.HandleAllocated) then
562      LockOnChange({%H-}PGtkObject(Owner.Handle),-1);
563    if (glsItemCacheNeedsUpdate in FStates) then
564      UpdateItemCache;
565  end;
566end;
567
568procedure TGtkListStringList.ConsistencyCheck;
569var
570  CurListItem: PGList;
571  i: integer;
572  RealCachedCount: Integer;
573  Str1: string;
574  Str2: string;
575begin
576  if FCachedCount>FCachedCapacity then RaiseGDBException('');
577  if (FCachedItems=nil) and (FCachedCapacity>0) then RaiseGDBException('');
578  if (FCachedItems<>nil) and (FCachedCapacity=0) then RaiseGDBException('');
579
580  UpdateItemCache;
581  if (FGtkList<>nil) and (FGtkList^.children<>nil) then
582    RealCachedCount:=g_list_length(FGtkList^.children)
583  else
584    RealCachedCount:=0;
585  if RealCachedCount<>FCachedCount then
586    RaiseGDBException('RealCachedCount='+IntToStr(RealCachedCount)
587      +' FCachedCount='+IntToStr(FCachedCount));
588  if FGtkList<>nil then begin
589    CurListItem:=FGtkList^.children;
590    i:=0;
591    while CurListItem<>nil do begin
592      if FCachedItems[i]<>PGtkListItem(CurListItem^.Data) then
593        RaiseGDBException(IntToStr(i));
594      inc(i);
595      CurListItem:=CurListItem^.Next;
596    end;
597  end;
598
599  if Sorted then begin
600    for i:=0 to FCachedCount-2 do begin
601      Str1:=Strings[i];
602      Str2:=Strings[i+1];
603      if (AnsiCompareText(Str1,Str2)>0) then
604        RaiseGDBException(IntToStr(i)+':'+Str1+'>'+IntToStr(i+1)+':'+Str2);
605    end;
606  end;
607end;
608
609{------------------------------------------------------------------------------
610  Method: TGtkListStringList.Assign
611  Params:
612  Returns:
613
614 ------------------------------------------------------------------------------}
615procedure TGtkListStringList.Assign(Source : TPersistent);
616var
617  i, Cnt: integer;
618  SrcStrings: TStrings;
619begin
620  if (Source=Self) or (Source=nil) then exit;
621  if ((Source is TGtkListStringList)
622    and (TGtkListStringList(Source).FGtkList=FGtkList))
623  then
624    RaiseGDBException('TGtkListStringList.Assign: There 2 lists with the same FGtkList');
625  BeginUpdate;
626//DebugLn('[TGtkListStringList.Assign] A ',Source.Classname,' Self=',DbgS(Self),' Source=',DbgS(Source));
627  try
628    if Source is TStrings then begin
629      // clearing and resetting can change other properties of the widget,
630      // => don't change if the content is already the same
631      SrcStrings:=TStrings(Source);
632      if IsEqual(SrcStrings,true) then exit;
633      Clear;
634      Cnt:=SrcStrings.Count;
635      for i:=0 to Cnt - 1 do begin
636        AddObject(SrcStrings[i],SrcStrings.Objects[i]);
637      end;
638      // ToDo: restore other settings
639
640      // Do not call inherited Assign as it does things we do not want to happen
641    end else
642      inherited Assign(Source);
643  finally
644    EndUpdate;
645  end;
646  {$IFDEF CheckGtkList}
647  ConsistencyCheck;
648  {$ENDIF}
649//DebugLn('[TGtkListStringList.Assign] END ',Source.Classname);
650end;
651
652{------------------------------------------------------------------------------
653  Method: TGtkListStringList.Get
654  Params:
655  Returns:
656
657 ------------------------------------------------------------------------------}
658function TGtkListStringList.Get(Index : integer) : string;
659var
660  Item : PChar;
661  ALabel : PGtkLabel;
662begin
663  //DebugLn('[TGtkListStringList.Get] Index=',Index,' Count=',Count);
664  ALabel:=GetLabel(Index);
665
666  if ALabel = nil then
667    Result:= ''
668  else begin
669    Item:=nil;
670    gtk_label_get(ALabel, @Item);
671    Result:= StrPas(Item);
672  end;
673end;
674
675function TGtkListStringList.GetObject(Index: Integer): TObject;
676var
677  ListItem : PGtkListItem;
678begin
679  //DebugLn('[TGtkListStringList.GetObject] Index=',Index,' Count=',Count);
680  Result:=nil;
681  ListItem:=GetListItem(Index);
682  if ListItem<>nil then
683    Result:=TObject(g_object_get_data(PGObject(ListItem),'LCLStringsObject'));
684end;
685
686procedure TGtkListStringList.Put(Index: Integer; const S: string);
687var
688  ALabel: PGtkLabel;
689  NewText: PChar;
690  SortedIndex: Integer;
691begin
692  //DebugLn('[TGtkListStringList.Put] Index=',Index,' Count=',Count);
693  if Sorted then begin
694    SortedIndex:=GetInsertPosition(S);
695    // we move instead of insert => adjust position
696    if SortedIndex>Index then dec(SortedIndex);
697  end else
698    SortedIndex:=Index;
699
700  // change label
701  ALabel:=GetLabel(Index);
702  if ALabel = nil then
703    RaiseGDBException('TGtkListStringList.Put');
704  if S<>'' then
705    NewText:=PChar(S)
706  else
707    NewText:=#0;
708  gtk_label_set_text(ALabel, NewText);
709  //set default font
710
711  // repair sorting
712  if Sorted and (SortedIndex<>Index) then begin
713    Move(Index,SortedIndex);
714  end;
715end;
716
717function TGtkListStringList.GetListItem(Index: integer): PGtkListItem;
718begin
719  if (Index < 0) or (Index >= Count) then
720    RaiseGDBException('TGtkListStringList.Get Out of bounds.')
721  else begin
722    UpdateItemCache;
723    Result:=FCachedItems[Index];
724  end;
725end;
726
727function TGtkListStringList.GetLabel(Index: integer): PGtkLabel;
728var
729  ListItem: PGtkListItem;
730begin
731  ListItem:=GetListItem(Index);
732
733  if FWithCheckBox then
734    Result := PPointer(PGTKBox(PGtkBin(ListItem)^.child)^.Children^.Next^.Data)^
735  else
736    Result := PGTKLabel(PGtkBin(ListItem)^.child);
737end;
738
739{------------------------------------------------------------------------------
740  Method: TGtkListStringList.GetCount
741  Params:
742  Returns:
743
744 ------------------------------------------------------------------------------}
745function TGtkListStringList.GetCount: integer;
746begin
747  if (FGtkList<>nil) and (FGtkList^.children <> nil) then begin
748    UpdateItemCache;
749    Result:=FCachedCount;
750  end else begin
751    Result:= 0
752  end;
753end;
754
755{------------------------------------------------------------------------------
756  Method: TGtkListStringList.Clear
757  Params:
758  Returns:
759
760 ------------------------------------------------------------------------------}
761procedure TGtkListStringList.Clear;
762var
763  i: integer;
764begin
765  BeginUpdate;
766  RemoveAllCallbacks;
767  for i:=0 to FCachedCount-1 do begin
768    {$IFDEF DebugLCLComponents}
769    DebugGtkWidgets.MarkDestroyed(FCachedItems[i]);
770    {$ENDIF}
771  end;
772  Include(FStates,glsItemCacheNeedsUpdate);
773  CheckForInvalidFocus;
774  if gtkListGetSelectionMode(FGtkList)=GTK_SELECTION_BROWSE then begin
775    // GTK_SELECTION_BROWSE always auto selects one child
776    // -> disable it and enable it when a selection is needed
777    gtk_list_set_selection_mode(FGtkList,GTK_SELECTION_SINGLE);
778  end;
779  gtk_list_clear_items(FGtkList, 0, Count);
780  FCachedCount:=0;
781  //Update the internal Item Index cache
782  if FOwner.HandleAllocated and (FOwner is TCustomComboBox) then
783    PInteger(GetWidgetInfo({%H-}Pointer(FOwner.Handle))^.UserData)^ := -1;
784  EndUpdate;
785  {$IFDEF CheckGtkList}
786  ConsistencyCheck;
787  {$ENDIF}
788end;
789
790{------------------------------------------------------------------------------
791  Method: TGtkListStringList.Delete
792  Params:
793  Returns:
794
795 ------------------------------------------------------------------------------}
796procedure TGtkListStringList.Delete(Index: integer);
797begin
798  UpdateItemCache;
799  RemoveItemCallbacks(Index);
800  {$IFDEF DebugLCLComponents}
801  DebugGtkWidgets.MarkDestroyed(FCachedItems[Index]);
802  {$ENDIF}
803  // remove item from cache
804  if (Index<FCachedCount-1) then begin
805    System.Move(FCachedItems[Index+1],FCachedItems[Index],
806      SizeOf(Pointer)*(FCachedCount-1-Index));
807  end;
808  // shrink cache (lazy)
809  dec(FCachedCount);
810  if (FCachedCount<(FCachedCapacity shr 2)) then begin
811    FCachedCapacity:=FCachedCapacity shr 1;
812    ReAllocMem(FCachedItems,SizeOf(PGtkListItem)*FCachedCapacity);
813  end;
814  // change selection mode if needed
815  if (gtkListGetSelectionMode(FGtkList)=GTK_SELECTION_BROWSE)
816  and (FGtkList^.selection<>nil)
817  and (g_list_nth_data(FGtkList^.children, Index)=FGtkList^.selection^.data) then begin
818    // item is selected and BROWSE mode is enabled
819    // -> change selection mode to prevent, that gtk auto selects another child
820    gtk_list_set_selection_mode(FGtkList,GTK_SELECTION_SINGLE);
821  end;
822
823  // remove item from gtk list
824  if Count = 0 then CheckForInvalidFocus;
825  gtk_list_clear_items(FGtkList, Index, Index + 1);
826  Include(FStates,glsItemCacheNeedsUpdate);
827
828  //Clear the combobox text and set item index to -1
829  if FOwner is TCustomComboBox then
830    TGtk2WSCustomComboBox.SetItemIndex(TCustomComboBox(FOwner), -1);
831
832  {$IFDEF CheckGtkList}
833  ConsistencyCheck;
834  {$ENDIF}
835end;
836
837{------------------------------------------------------------------------------
838  function TGtkListStringList.IndexOf(const S: string): Integer;
839
840  Returns index of item with string.
841 ------------------------------------------------------------------------------}
842function TGtkListStringList.IndexOf(const S: string): Integer;
843var
844  l, m, r, cmp: integer;
845begin
846  if FSorted then begin
847    l:=0;
848    r:=Count-1;
849    m:=l;
850    while (l<=r) do begin
851      m:=(l+r) shr 1;
852      cmp:=AnsiCompareText(S,Strings[m]);
853
854      if cmp<0 then
855        r:=m-1
856      else if cmp>0 then
857        l:=m+1
858      else begin
859        Result:=m;
860        exit;
861      end;
862    end;
863    Result:=-1;
864  end else begin
865    Result:=inherited IndexOf(S);
866  end;
867end;
868
869{------------------------------------------------------------------------------
870  Method: TGtkListStringList.Insert
871  Params:
872  Returns:
873
874 ------------------------------------------------------------------------------}
875procedure TGtkListStringList.Insert(Index : integer; const S : string);
876var
877  li, cb, box,aLabel: PGtkWidget;
878  item_requisition: TGtkRequisition;
879  OldCount: LongInt;
880  LCLIndex: PInteger;
881
882  procedure RaiseIndexOutOfBounds;
883  begin
884    RaiseGDBException('TGtkListStringList.Insert: Index '+IntToStr(Index)
885      +' out of bounds. Count='+IntToStr(OldCount));
886  end;
887
888begin
889  OldCount:=Count;
890  BeginUpdate;
891  try
892    if FSorted then begin
893      Index:=GetInsertPosition(S);
894    end;
895    if (Index < 0) or (Index > OldCount) then
896      RaiseIndexOutOfBounds;
897    if Owner = nil then RaiseGDBException(
898      'TGtkListStringList.Insert Unspecified owner');
899
900    // ToDo:
901    //  - Icons
902    //  - measure item
903
904    if FWithCheckBox
905    then begin
906      li := gtk_list_item_new;
907      box := gtk_hbox_new(False, 0); //^Pointer(PGTKBox(box)^.children^.Next^.Data)^
908      gtk_container_add(PGTKContainer(li), box);
909      cb := gtk_check_button_new;
910      gtk_box_pack_start(PGTKBox(box), cb, False, False, 0);
911
912      aLabel:=gtk_label_new(PChar(S));
913      if not TListBox(Owner).Font.IsDefault then begin
914        Gtk2WidgetSet.SetWidgetColor(aLabel, TListBox(Owner).Font.Color, clNone,
915              [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
916        Gtk2WidgetSet.SetWidgetFont(aLabel, TListBox(Owner).Font);
917      end;
918      gtk_box_pack_start(PGTKBox(box), aLabel, False, False, 0);
919    end
920    else begin
921      li:=gtk_list_item_new_with_label(PChar(S));
922      aLabel:=PGtkBin(li)^.child;
923      if not TListBox(Owner).Font.IsDefault then begin
924        Gtk2WidgetSet.SetWidgetColor(aLabel, TListBox(Owner).Font.Color, clNone,
925            [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
926        Gtk2WidgetSet.SetWidgetFont(aLabel, TListBox(Owner).Font);
927      end;
928    end;
929    {$IFDEF DebugLCLComponents}
930    DebugGtkWidgets.MarkCreated(li,dbgsName(Owner)+' Index='+dbgs(Index)+' Count='+dbgs(Count));
931    {$ENDIF}
932    {$IFDEF EventTrace}
933    Debugln('insertListItem',s);
934    {$ENDIF}
935    ConnectItemCallbacks(PGtkListItem(li));
936    // grow capacity
937    UpdateItemCache;
938    if (FCachedCapacity<=OldCount) then begin
939      if FCachedCapacity=0 then FCachedCapacity:=1;
940      while (FCachedCapacity<=OldCount) do
941        FCachedCapacity:=FCachedCapacity shl 1;
942      ReAllocMem(FCachedItems,SizeOf(PGtkListItem)*FCachedCapacity);
943    end;
944    // insert item in cache
945    inc(FCachedCount);
946    if Index<OldCount then
947      System.Move(FCachedItems[Index],FCachedItems[Index+1],
948                  SizeOf(PGtkListItem)*(OldCount-Index));
949    FCachedItems[Index]:=PGtkListItem(li);
950    // insert in gtk
951    gtk_widget_show_all(li);
952    gtk_list_insert_items(FGtkList, g_list_append(nil, li), Index);
953    //if the item is inserted before the selected item the
954    //internal index cache becomes out of sync
955    if (FOwner is TCustomComboBox) and FOwner.HandleAllocated then
956    begin
957      LCLIndex := PInteger(GetWidgetInfo({%H-}Pointer(FOwner.Handle))^.UserData);
958      if Index <= LCLIndex^ then
959        Inc(LCLIndex^);
960    end;
961    // adjust gtk height
962    if (Owner is TCustomListBox)
963    and (TListBox(Owner).ItemHeight>1) then begin
964      if li^.Allocation.Width>1 then
965        item_requisition.Width:=li^.Allocation.Width
966      else
967        gtk_widget_size_request(li,@item_requisition);
968      gtk_widget_set_usize(li,Max(li^.Allocation.Width,item_requisition.Width),
969                           TListBox(Owner).ItemHeight);
970    end;
971  finally
972    EndUpdate;
973    {$IFDEF CheckGtkList}
974    ConsistencyCheck;
975    {$ENDIF}
976  end;
977//DebugLn('[TGtkListStringList.Insert] END Index=',Index,' Count=',Count,' ',S,',',Count);
978end;
979
980function TGtkListStringList.GetInsertPosition(const S: string): integer;
981var
982  l: Integer;
983  Cnt: LongInt;
984  r: Integer;
985  m: LongInt;
986  cmp: LongInt;
987begin
988  Cnt:=Count;
989  if FSorted then begin
990    l:=0;
991    r:=Cnt-1;
992    m:=l;
993    while (l<=r) do begin
994      m:=(l+r) shr 1;
995      cmp:=AnsiCompareText(S,Strings[m]);
996      if cmp<0 then
997        r:=m-1
998      else if cmp>0 then
999        l:=m+1
1000      else
1001        break;
1002    end;
1003    if (m<Cnt) and (AnsiCompareText(S,Strings[m])>0) then
1004      inc(m);
1005    Result:=m;
1006  end else begin
1007    Result:=Cnt;
1008  end;
1009end;
1010
1011procedure TGtkListStringList.Move(FromIndex, ToIndex: Integer);
1012var
1013  Item: PGtkListItem;
1014begin
1015  if (FromIndex=ToIndex) then exit;
1016
1017  //debugln('TGtkListStringList.Move From=',dbgs(FromIndex),' To=',dbgs(ToIndex));
1018  Item:=GetListItem(FromIndex);
1019
1020  // move in gtk
1021  MoveGListLink(FGtkList^.children,FromIndex,ToIndex);
1022  if (GTK_WIDGET_VISIBLE (PGtkWidget(FGtkList))) then
1023    gtk_widget_queue_resize (PGtkWidget(FGtkList));
1024
1025  // move in cache
1026  if CacheValid then begin
1027    if FromIndex<ToIndex then begin
1028      System.Move(FCachedItems[FromIndex+1],FCachedItems[FromIndex],
1029                  SizeOf(PGtkListItem)*(ToIndex-FromIndex));
1030    end else begin
1031      System.Move(FCachedItems[ToIndex],FCachedItems[ToIndex+1],
1032                  SizeOf(PGtkListItem)*(FromIndex-ToIndex));
1033    end;
1034    FCachedItems[ToIndex]:=Item;
1035  end;
1036end;
1037
1038