View Issue Details

IDProjectCategoryView StatusLast Update
0011942LazarusLCLpublic2011-12-01 11:22
ReportermittagAssigned ToMarc Weustink 
PrioritynormalSeveritymajorReproducibilityhave not tried
Status closedResolutionfixed 
Product Version0.9.24Product Build 
Target Version0.9.30Fixed in Version0.9.29 (SVN) 
Summary0011942: sorted Tstrings with objects
DescriptionThere is a problem with sorted Tstrings under gtk2 when strings have objects. The strings are well sorted but not objects...
TagsNo tags attached.
Fixed in Revision23347
LazTarget0.9.30
WidgetsetGTK, GTK 2
Attached Files
  • Laz_CB_Testcase.tar.gz (1,865 bytes)
  • gtk2int.diff (22,917 bytes)
    Index: interfaces/gtk2/gtk2int.pas
    ===================================================================
    --- interfaces/gtk2/gtk2int.pas	(Revision 23150)
    +++ interfaces/gtk2/gtk2int.pas	(Arbeitskopie)
    @@ -37,7 +37,7 @@
       Types, Classes, SysUtils, Math,
       {$IfNDef GTK2_2}
         {$IfDef HasX}
    -     XLib, X, //XUtil,
    +  XLib, X, //XUtil,
         {$EndIf}
       {$EndIf}
     
    @@ -66,11 +66,13 @@
         procedure AppInit(var ScreenInfo: TScreenInfo); override;
         function AppHandle: THandle; override;
     
    -    procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject; const ALCLObject: TObject; Direct: boolean);override;
    -    procedure SetCommonCallbacks(const AGTKObject: PGTKObject; const ALCLObject: TObject); override;
    +    procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject;
    +      const ALCLObject: TObject; Direct: Boolean); override;
    +    procedure SetCommonCallbacks(const AGTKObject: PGTKObject;
    +      const ALCLObject: TObject); override;
         procedure SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String); override;
         procedure SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
    -      MultiSelect, ExtendedSelect: boolean); override;
    +      MultiSelect, ExtendedSelect: Boolean); override;
         procedure SetWidgetFont(const AWidget: PGtkWidget; const AFont: TFont); override;
     
         {$I gtk2winapih.inc}
    @@ -81,46 +83,47 @@
     
       TGtkListStoreStringList = class(TStrings)
       private
    -    FChangeStamp: integer;
    -    FColumnIndex : Integer;
    -    FGtkListStore : PGtkListStore;
    +    FChangeStamp: Integer;
    +    FColumnIndex: Integer;
    +    FGtkListStore: PGtkListStore;
         FOwner: TWinControl;
    -    FSorted : boolean;
    +    FSorted: Boolean;
         FStates: TGtkListStringsStates;
    -    FCachedCount: integer;
    -    FCachedCapacity: integer;
    -    FCachedSize: integer;
    +    FCachedCount: Integer;
    +    FCachedCapacity: Integer;
    +    FCachedSize: Integer;
         FCachedItems: PGtkTreeIter;
    -    FUpdateCount: integer;
    +    FUpdateCount: Integer;
       protected
    -    function GetCount : integer; override;
    -    function Get(Index : Integer) : string; override;
    +    function GetCount: Integer; override;
    +    function Get(Index: Integer): String; override;
         function GetObject(Index: Integer): TObject; override;
    -    procedure Put(Index: Integer; const S: string); override;
    +    procedure Put(Index: Integer; const S: String); override;
         procedure PutObject(Index: Integer; AnObject: TObject); override;
    -    procedure SetSorted(Val : boolean); virtual;
    +    procedure SetSorted(Val: Boolean); virtual;
         procedure UpdateItemCache;
         procedure GrowCache;
         procedure ShrinkCache;
         procedure IncreaseChangeStamp;
       public
    -    constructor Create(TheListStore : PGtkListStore;
    -                       ColumnIndex : Integer; TheOwner: TWinControl);
    +    constructor Create(TheListStore: PGtkListStore; ColumnIndex: Integer;
    +      TheOwner: TWinControl);
         destructor Destroy; override;
    -    function Add(const S: string): Integer; override;
    -    procedure Assign(Source : TPersistent); override;
    +    function Add(const S: String): Integer; override;
    +    procedure Assign(Source: TPersistent); override;
         procedure Clear; override;
    -    procedure Delete(Index : integer); override;
    -    function IndexOf(const S: string): Integer; override;
    -    procedure Insert(Index : integer; const S: string); override;
    +    procedure Delete(Index: Integer); override;
    +    function Find(const S: String; var Index: Integer): Boolean;
    +    function IndexOf(const S: String): Integer; override;
    +    procedure Insert(Index: Integer; const S: String); override;
         procedure Sort; virtual;
    -    function IsEqual(List: TStrings): boolean;
    +    function IsEqual(List: TStrings): Boolean;
         procedure BeginUpdate;
         procedure EndUpdate;
       public
    -    property Sorted : boolean read FSorted write SetSorted;
    +    property Sorted: Boolean read FSorted write SetSorted;
         property Owner: TWinControl read FOwner;
    -    property ChangeStamp: integer read FChangeStamp;
    +    property ChangeStamp: Integer read FChangeStamp;
       end;
     
     var
    @@ -128,7 +131,7 @@
     
     
     implementation
    -  
    +
     uses
     {$ifdef Windows}
       Gtk2Windows,
    @@ -136,7 +139,7 @@
       Gtk2WSFactory,
       Gtk2WSStdCtrls,
       Gtk2Themes,
    -////////////////////////////////////////////////////
    +  ////////////////////////////////////////////////////
       GtkProc,
       GtkDebug;
     
    @@ -158,39 +161,44 @@
       Returns:
     
      ------------------------------------------------------------------------------}
    -constructor TGtkListStoreStringList.Create(TheListStore : PGtkListStore;
    -  ColumnIndex : Integer; TheOwner: TWinControl);
    +constructor TGtkListStoreStringList.Create(TheListStore: PGtkListStore;
    +  ColumnIndex: Integer; TheOwner: TWinControl);
     begin
       inherited Create;
    -  if TheListStore = nil then RaiseGDBException(
    -    'TGtkListStoreStringList.Create Unspecified list store');
    -  fGtkListStore:=TheListStore;
    +  if TheListStore = nil then
    +    RaiseGDBException(
    +      'TGtkListStoreStringList.Create Unspecified list store');
    +  fGtkListStore := TheListStore;
     
    -  if (ColumnIndex < 0) or
    -    (ColumnIndex >= gtk_tree_model_get_n_columns(GTK_TREE_MODEL(fGtkListStore)))
    -  then
    +  if (ColumnIndex < 0) or (ColumnIndex >=
    +    gtk_tree_model_get_n_columns(GTK_TREE_MODEL(fGtkListStore))) then
         RaiseGDBException('TGtkListStoreStringList.Create Invalid Column Index');
    -  FColumnIndex:=ColumnIndex;
    +  FColumnIndex := ColumnIndex;
     
    -  if TheOwner = nil then RaiseGDBException(
    -    'TGtkListStoreStringList.Create Unspecified owner');
    -  FOwner:=TheOwner;
    -  FStates:=[glsItemCacheNeedsUpdate,glsCountNeedsUpdate];
    +  if TheOwner = nil then
    +    RaiseGDBException(
    +      'TGtkListStoreStringList.Create Unspecified owner');
    +  FOwner := TheOwner;
    +  FStates := [glsItemCacheNeedsUpdate, glsCountNeedsUpdate];
     end;
     
     destructor TGtkListStoreStringList.Destroy;
     begin
    -  fGtkListStore:=nil;
    +  fGtkListStore := nil;
       // don't destroy the widgets
    -  ReAllocMem(FCachedItems,0);
    +  ReAllocMem(FCachedItems, 0);
       inherited Destroy;
     end;
     
    -function TGtkListStoreStringList.Add(const S: string): Integer;
    +function TGtkListStoreStringList.Add(const S: String): Integer;
     begin
    -  Result:=Count;
    +  if FSorted then
    +    Find(S, Result)
    +  else
    +    Result := Count;
    +
       //DebugLn(['TGtkListStoreStringList.Add ',S,' Count=',Result]);
    -  Insert(Count,S);
    +  Insert(Result, S);
     end;
     
     {------------------------------------------------------------------------------
    @@ -199,20 +207,24 @@
       Returns:
     
      ------------------------------------------------------------------------------}
    -procedure TGtkListStoreStringList.SetSorted(Val : boolean);
    +procedure TGtkListStoreStringList.SetSorted(Val: Boolean);
     var
       i: Integer;
     begin
    -  if Val <> FSorted then begin
    -    if Val then begin
    -      for i:=0 to Count-2 do begin
    -        if AnsiCompareText(Strings[i],Strings[i+1])<0 then begin
    +  if Val <> FSorted then
    +  begin
    +    if Val then
    +    begin
    +      for i := 0 to Count - 2 do
    +      begin
    +        if AnsiCompareText(Strings[i], Strings[i + 1]) < 0 then
    +        begin
               Sort;
    -          break;
    +          Break;
             end;
           end;
         end;
    -    FSorted:= Val;
    +    FSorted := Val;
       end;
     end;
     
    @@ -223,51 +235,53 @@
     
     procedure TGtkListStoreStringList.UpdateItemCache;
     var
    -  i: integer;
    +  i: Integer;
     begin
    -  if not (glsItemCacheNeedsUpdate in FStates) then exit;
    +  if not (glsItemCacheNeedsUpdate in FStates) then
    +    Exit;
       //DebugLn(['TGtkListStoreStringList.UpdateItemCache ']); DumpStack;
    -  FCachedSize:=Count;
    -  FCachedCapacity:=Count;
    -  ReAllocMem(FCachedItems,SizeOf(TGtkTreeIter)*FCachedCapacity);
    -  if FGtkListStore<>nil then
    -    For I := 0 to FCachedSize - 1 do
    +  FCachedSize := Count;
    +  FCachedCapacity := Count;
    +  ReAllocMem(FCachedItems, SizeOf(TGtkTreeIter) * FCachedCapacity);
    +  if FGtkListStore <> nil then
    +    for I := 0 to FCachedSize - 1 do
           gtk_tree_model_iter_nth_child(GTK_TREE_MODEL(FGtkListStore),
             @FCachedItems[i], nil, I);
    -  Exclude(FStates,glsItemCacheNeedsUpdate);
    +  Exclude(FStates, glsItemCacheNeedsUpdate);
     end;
     
     procedure TGtkListStoreStringList.GrowCache;
     begin
    -  FCachedCapacity:=((FCachedCapacity*5) div 4)+10;
    -  ReAllocMem(FCachedItems,SizeOf(TGtkTreeIter)*FCachedCapacity);
    +  FCachedCapacity := ((FCachedCapacity * 5) div 4) + 10;
    +  ReAllocMem(FCachedItems, SizeOf(TGtkTreeIter) * FCachedCapacity);
     end;
     
     procedure TGtkListStoreStringList.ShrinkCache;
     begin
    -  FCachedCapacity:=FCachedSize+1;
    -  ReAllocMem(FCachedItems,SizeOf(TGtkTreeIter)*FCachedCapacity);
    +  FCachedCapacity := FCachedSize + 1;
    +  ReAllocMem(FCachedItems, SizeOf(TGtkTreeIter) * FCachedCapacity);
     end;
     
     procedure TGtkListStoreStringList.IncreaseChangeStamp;
     begin
    -  if FChangeStamp<High(FChangeStamp) then
    -    inc(FChangeStamp)
    +  if FChangeStamp < High(FChangeStamp) then
    +    Inc(FChangeStamp)
       else
    -    FChangeStamp:=Low(FChangeStamp);
    +    FChangeStamp := Low(FChangeStamp);
     end;
     
     procedure TGtkListStoreStringList.PutObject(Index: Integer; AnObject: TObject);
     var
    -  ListItem : TGtkTreeIter;
    +  ListItem: TGtkTreeIter;
     begin
       if (Index < 0) or (Index >= Count) then
         RaiseGDBException('TGtkListStoreStringList.PutObject Out of bounds.')
    -  else if FGtkListStore<>nil then begin
    +  else if FGtkListStore <> nil then
    +  begin
         UpdateItemCache;
    -    ListItem:=FCachedItems[Index];
    +    ListItem := FCachedItems[Index];
         gtk_list_store_set(FGtkListStore, @ListItem,
    -                       [FColumnIndex+1, Pointer(AnObject), -1]);
    +      [FColumnIndex + 1, Pointer(AnObject), -1]);
         IncreaseChangeStamp;
       end;
     end;
    @@ -285,44 +299,48 @@
     begin
       BeginUpdate;
       // sort internally (sorting in the widget would be slow and unpretty ;)
    -  sl:=TStringList.Create;
    +  sl := TStringList.Create;
       sl.Assign(Self);
    -  MergeSort(sl,@AnsiCompareText);
    -  OldSorted:=Sorted;
    -  FSorted:=false;
    +  sl.Sort;
    +  OldSorted := Sorted;
    +  FSorted := False;
       Assign(sl);
    -  FSorted:=OldSorted;
    +  FSorted := OldSorted;
       sl.Free;
       EndUpdate;
     end;
     
    -function TGtkListStoreStringList.IsEqual(List: TStrings): boolean;
    +function TGtkListStoreStringList.IsEqual(List: TStrings): Boolean;
     var
    -  i, Cnt: integer;
    +  i, Cnt: Integer;
     begin
    -  if List=Self then begin
    -    Result:=true;
    -    exit;
    +  if List = Self then
    +  begin
    +    Result := True;
    +    Exit;
       end;
    -  Result:=false;
    -  if List=nil then exit;
    +  Result := False;
    +  if List = nil then
    +    Exit;
       BeginUpdate;
    -  Cnt:=Count;
    -  if (Cnt<>List.Count) then exit;
    -  for i:=0 to Cnt-1 do
    -    if (Strings[i]<>List[i]) or (Objects[i]<>List.Objects[i]) then exit;
    -  Result:=true;
    +  Cnt := Count;
    +  if (Cnt <> List.Count) then
    +    Exit;
    +  for i := 0 to Cnt - 1 do
    +    if (Strings[i] <> List[i]) or (Objects[i] <> List.Objects[i]) then
    +      Exit;
    +  Result := True;
       EndUpdate;
     end;
     
     procedure TGtkListStoreStringList.BeginUpdate;
     begin
    -  inc(FUpdateCount);
    +  Inc(FUpdateCount);
     end;
     
     procedure TGtkListStoreStringList.EndUpdate;
     begin
    -  dec(FUpdateCount);
    +  Dec(FUpdateCount);
     end;
     
     {------------------------------------------------------------------------------
    @@ -331,46 +349,53 @@
       Returns:
     
      ------------------------------------------------------------------------------}
    -procedure TGtkListStoreStringList.Assign(Source : TPersistent);
    +procedure TGtkListStoreStringList.Assign(Source: TPersistent);
     var
    -  i, Cnt: integer;
    +  i, Cnt: Integer;
       CmpList: TStrings;
       OldSorted: Boolean;
     begin
    -  if (Source=Self) or (Source=nil) then exit;
    -  if ((Source is TGtkListStoreStringList)
    -    and (TGtkListStoreStringList(Source).FGtkListStore=FGtkListStore))
    -  then
    +  if (Source = Self) or (Source = nil) then
    +    Exit;
    +  if ((Source is TGtkListStoreStringList) and
    +    (TGtkListStoreStringList(Source).FGtkListStore = FGtkListStore)) then
         RaiseGDBException('TGtkListStoreStringList.Assign: There are 2 lists with the same FGtkListStore');
       BeginUpdate;
    -  OldSorted:=Sorted;
    -  CmpList:=nil;
    +  OldSorted := Sorted;
    +  CmpList := nil;
       try
    -    if Source is TStrings then begin
    +    if Source is TStrings then
    +    begin
           // clearing and resetting can change other properties of the widget,
           // => don't change if the content is already the same
    -      if Sorted then begin
    -        CmpList:=TStringList.Create;
    +      if Sorted then
    +      begin
    +        CmpList := TStringList.Create;
             CmpList.Assign(TStrings(Source));
    -        MergeSort(TStringList(CmpList),@AnsiCompareText);
    -      end else
    -        CmpList:=TStrings(Source);
    -      if IsEqual(CmpList) then exit;
    +        TStringList(CmpList).Sort;
    +      end
    +      else
    +        CmpList := TStrings(Source);
    +      if IsEqual(CmpList) then
    +        Exit;
           Clear;
    -      FSorted:=false;
    -      Cnt:=TStrings(Source).Count;
    -      for i:=0 to Cnt - 1 do begin
    -        AddObject(CmpList[i],CmpList.Objects[i]);
    +      FSorted := False;
    +      Cnt := TStrings(Source).Count;
    +      for i := 0 to Cnt - 1 do
    +      begin
    +        AddObject(CmpList[i], CmpList.Objects[i]);
             //DebugLn(['TGtkListStoreStringList.Assign ',i,' ',CmpList[i],' ',Count]);
           end;
           // ToDo: restore other settings
     
           // Do not call inherited Assign as it does things we do not want to happen
    -    end else
    +    end
    +    else
           inherited Assign(Source);
       finally
    -    fSorted:=OldSorted;
    -    if CmpList<>Source then CmpList.Free;
    +    fSorted := OldSorted;
    +    if CmpList <> Source then
    +      CmpList.Free;
         EndUpdate;
       end;
     end;
    @@ -381,52 +406,56 @@
       Returns:
     
      ------------------------------------------------------------------------------}
    -function TGtkListStoreStringList.Get(Index : integer) : string;
    +function TGtkListStoreStringList.Get(Index: Integer): String;
     var
    -  Item : PChar;
    -  ListItem : TGtkTreeIter;
    +  Item: PChar;
    +  ListItem: TGtkTreeIter;
     begin
       if (Index < 0) or (Index >= Count) then
         RaiseGDBException('TGtkListStoreStringList.Get Out of bounds.')
    -  else begin
    +  else
    +  begin
         UpdateItemCache;
    -    ListItem:=FCachedItems[Index];
    +    ListItem := FCachedItems[Index];
     
         Item := nil;
         gtk_tree_model_get(GTK_TREE_MODEL(FGtkListStore), @ListItem,
    -                       [FColumnIndex, @Item, -1]);
    -    if (Item <> nil) then begin
    -      Result:= StrPas(Item);
    +      [FColumnIndex, @Item, -1]);
    +    if (Item <> nil) then
    +    begin
    +      Result := StrPas(Item);
           g_free(Item);
         end
         else
    -      result := '';
    +      Result := '';
       end;
     end;
     
     function TGtkListStoreStringList.GetObject(Index: Integer): TObject;
     var
    -  ListItem : TGtkTreeIter;
    +  ListItem: TGtkTreeIter;
     begin
    -  Result:=nil;
    +  Result := nil;
       if (Index < 0) or (Index >= Count) then
         RaiseGDBException('TGtkListStoreStringList.GetObject Out of bounds.')
    -  else if FGtkListStore<>nil then begin
    +  else if FGtkListStore <> nil then
    +  begin
         UpdateItemCache;
    -    ListItem:=FCachedItems[Index];
    -    gtk_tree_model_get(FGtkListStore, @ListItem, [FColumnIndex+1, @Result, -1]);
    +    ListItem := FCachedItems[Index];
    +    gtk_tree_model_get(FGtkListStore, @ListItem, [FColumnIndex + 1, @Result, -1]);
       end;
     end;
     
    -procedure TGtkListStoreStringList.Put(Index: Integer; const S: string);
    +procedure TGtkListStoreStringList.Put(Index: Integer; const S: String);
     var
    -  ListItem : TGtkTreeIter;
    +  ListItem: TGtkTreeIter;
     begin
       if (Index < 0) or (Index >= Count) then
         RaiseGDBException('TGtkListStoreStringList.Put Out of bounds.')
    -  else if FGtkListStore<>nil then begin
    +  else if FGtkListStore <> nil then
    +  begin
         UpdateItemCache;
    -    ListItem:=FCachedItems[Index];
    +    ListItem := FCachedItems[Index];
         gtk_list_store_set(FGtkListStore, @ListItem, [FColumnIndex, PChar(S), -1]);
         IncreaseChangeStamp;
       end;
    @@ -438,16 +467,17 @@
       Returns:
     
      ------------------------------------------------------------------------------}
    -function TGtkListStoreStringList.GetCount: integer;
    +function TGtkListStoreStringList.GetCount: Integer;
     begin
    -  if (glsCountNeedsUpdate in FStates) then begin
    -    if FGtkListStore<>nil then
    -      FCachedCount:=gtk_tree_model_iter_n_children(GTK_TREE_MODEL(FGtkListStore),nil)
    +  if (glsCountNeedsUpdate in FStates) then
    +  begin
    +    if FGtkListStore <> nil then
    +      FCachedCount := gtk_tree_model_iter_n_children(GTK_TREE_MODEL(FGtkListStore), nil)
         else
    -      FCachedCount:=0;
    -    Exclude(FStates,glsCountNeedsUpdate);
    +      FCachedCount := 0;
    +    Exclude(FStates, glsCountNeedsUpdate);
       end;
    -  Result:=FCachedCount;
    +  Result := FCachedCount;
     end;
     
     {------------------------------------------------------------------------------
    @@ -465,25 +495,26 @@
     
       //Lock the widget to avoid trigger events
       //Note: Assign/Clear is called inside CreateHandle before Handle is set
    -  if FOwner.HandleAllocated then begin
    +  if FOwner.HandleAllocated then
    +  begin
         WidgetInfo := GetWidgetInfo(Pointer(FOwner.Handle), False);
         Inc(WidgetInfo^.ChangeLock);
    -    
    +
         gtk_list_store_clear(FGtkListStore);
     
         Dec(WidgetInfo^.ChangeLock);
         //Update the internal Index cache
         PInteger(WidgetInfo^.UserData)^ := -1;
       end;
    -    
    +
       IncreaseChangeStamp;
     
    -  ReAllocMem(FCachedItems,0);
    -  FCachedCapacity:=0;
    -  FCachedSize:=0;
    -  Exclude(FStates,glsItemCacheNeedsUpdate);
    -  FCachedCount:=0;
    -  Exclude(FStates,glsCountNeedsUpdate);
    +  ReAllocMem(FCachedItems, 0);
    +  FCachedCapacity := 0;
    +  FCachedSize := 0;
    +  Exclude(FStates, glsItemCacheNeedsUpdate);
    +  FCachedCount := 0;
    +  Exclude(FStates, glsCountNeedsUpdate);
     end;
     
     {------------------------------------------------------------------------------
    @@ -492,7 +523,7 @@
       Returns:
     
      ------------------------------------------------------------------------------}
    -procedure TGtkListStoreStringList.Delete(Index : integer);
    +procedure TGtkListStoreStringList.Delete(Index: Integer);
     var
       ListItem: TGtkTreeIter;
       WidgetInfo: PWidgetInfo;
    @@ -509,16 +540,17 @@
       gtk_list_store_remove(FGtkListStore, @ListItem);
       Dec(WidgetInfo^.ChangeLock);
       IncreaseChangeStamp;
    -  
    +
       if not (glsCountNeedsUpdate in FStates) then
    -    dec(FCachedCount);
    -  if (not (glsItemCacheNeedsUpdate in FStates)) and (Index=Count) then
    +    Dec(FCachedCount);
    +  if (not (glsItemCacheNeedsUpdate in FStates)) and (Index = Count) then
       begin
         // cache is valid and the last item was deleted -> just remove last item
    -    dec(FCachedSize);
    +    Dec(FCachedSize);
         if (FCachedSize < FCachedCapacity div 2) then
           ShrinkCache;
    -  end else
    +  end
    +  else
         Include(FStates, glsItemCacheNeedsUpdate);
     
       if FOwner is TCustomComboBox then
    @@ -529,32 +561,44 @@
       end;
     end;
     
    -function TGtkListStoreStringList.IndexOf(const S: string): Integer;
    +function TGtkListStoreStringList.Find(const S: String; var Index: Integer): Boolean;
     var
    -  l, m, r, cmp: integer;
    +  L, R, I: Integer;
    +  CompareRes: Integer;
     begin
    -  BeginUpdate;
    -  if FSorted then begin
    -    l:=0;
    -    r:=Count-1;
    -    m:=l;
    -    while (l<=r) do begin
    -      m:=(l+r) shr 1;
    -      cmp:=AnsiCompareText(S,Strings[m]);
    -
    -      if cmp<0 then
    -        r:=m-1
    -      else if cmp>0 then
    -        l:=m+1
    -      else begin
    -        Result:=m;
    -        exit;
    +  Result := False;
    +  // Use binary search.
    +  L := 0;
    +  R := Count - 1;
    +  while (L <= R) do
    +  begin
    +    I := L + (R - L) div 2;
    +    CompareRes := AnsiCompareText(S, Strings[I]);
    +    if (CompareRes > 0) then
    +      L := I + 1
    +    else
    +    begin
    +      R := I - 1;
    +      if (CompareRes = 0) then
    +      begin
    +        Result := True;
    +        L := I; // forces end of while loop
           end;
         end;
    -    Result:=-1;
    -  end else begin
    -    Result:=inherited IndexOf(S);
       end;
    +  Index := L;
    +end;
    +
    +function TGtkListStoreStringList.IndexOf(const S: String): Integer;
    +begin
    +  BeginUpdate;
    +  if FSorted then
    +  begin
    +    //Binary Search
    +    if not Find(S, Result) then
    +      Result := -1;
    +  end else
    +    Result := inherited IndexOf(S);
       EndUpdate;
     end;
     
    @@ -564,12 +608,12 @@
       Returns:
     
      ------------------------------------------------------------------------------}
    -procedure TGtkListStoreStringList.Insert(Index : integer; const S : string);
    +procedure TGtkListStoreStringList.Insert(Index: Integer; const S: String);
     var
    -  li : TGtkTreeIter;
    -  l, m, r, cmp: integer;
    +  li: TGtkTreeIter;
    +  l, m, r, cmp: Integer;
       LCLIndex: PInteger;
    -  
    +
       {procedure TestNewItem;
       var
         Item: PChar;
    @@ -590,36 +634,20 @@
         else
           DebugLn(['TestNewItem FAILED: new item missing']);
       end;}
    -  
    +
     begin
       BeginUpdate;
       try
    -    if FSorted then begin
    -      l:=0;
    -      r:=Count-1;
    -      m:=l;
    -      while (l<=r) do begin
    -        m:=(l+r) shr 1;
    -        cmp:=AnsiCompareText(S,Strings[m]);
    -        if cmp<0 then
    -          r:=m-1
    -        else if cmp>0 then
    -          l:=m+1
    -        else
    -          break;
    -      end;
    -      if (m<Count) and (AnsiCompareText(S,Strings[m])>0) then
    -        inc(m);
    -      Index:=m;
    -    end;
         if (Index < 0) or (Index > Count) then
    -      RaiseGDBException('TGtkListStoreStringList.Insert: Index '+IntToStr(Index)
    -        +' out of bounds. Count='+IntToStr(Count));
    -    if Owner = nil then RaiseGDBException(
    -      'TGtkListStoreStringList.Insert Unspecified owner');
    +      RaiseGDBException('TGtkListStoreStringList.Insert: Index ' +
    +        IntToStr(Index) + ' out of bounds. Count=' + IntToStr(Count));
    +    if Owner = nil then
    +      RaiseGDBException(
    +        'TGtkListStoreStringList.Insert Unspecified owner');
     
         // this call is few times faster than gtk_list_store_insert, gtk_list_store_set
    -    gtk_list_store_insert_with_values(FGtkListStore, @li, Index, FColumnIndex, PChar(S), -1);
    +    gtk_list_store_insert_with_values(FGtkListStore, @li, Index,
    +      FColumnIndex, PChar(S), -1);
         IncreaseChangeStamp;
     
         //if the item is inserted before the selected item the
    @@ -634,17 +662,20 @@
         // ToDo: connect callbacks
     
         if not (glsCountNeedsUpdate in FStates) then
    -      inc(FCachedCount);
    +      Inc(FCachedCount);
     
    -    if (not (glsItemCacheNeedsUpdate in FStates)) and (Index=Count-1) then begin
    +    if (not (glsItemCacheNeedsUpdate in FStates)) and (Index = Count - 1) then
    +    begin
           // cache is valid and item was added as last
           // Add item to cache (instead of updating the whole cache)
           // This accelerates Assign.
    -      if FCachedSize=FCachedCapacity then GrowCache;
    -      FCachedItems[FCachedSize]:=li;
    -      inc(FCachedSize);
    -    end else
    -      Include(FStates,glsItemCacheNeedsUpdate);
    +      if FCachedSize = FCachedCapacity then
    +        GrowCache;
    +      FCachedItems[FCachedSize] := li;
    +      Inc(FCachedSize);
    +    end
    +    else
    +      Include(FStates, glsItemCacheNeedsUpdate);
     
         //TestNewItem;
       finally
    @@ -653,3 +684,4 @@
     end;
     
     end.
    +
    
    gtk2int.diff (22,917 bytes)

Relationships

related to 0015356 closedMarc Weustink TGtkListStoreStringList.Add returns wrong index when sorted 

Activities

Vincent Snijders

2008-08-21 19:41

manager   ~0021573

From what component did you use the TStrings?

Michael Van Canneyt

2008-08-21 20:01

administrator   ~0021574

I can confirm the problem e.g. with TCheckListBox in GTK 1

mittag

2008-08-22 10:13

reporter   ~0021590

I have this problem with a TcomboBox (GTK 2)

2009-12-16 21:12

 

Laz_CB_Testcase.tar.gz (1,865 bytes)

Andreas Schneider

2009-12-16 21:12

reporter   ~0033125

In case it helps, I attached a small test case (since the problem still exists).

Andreas Schneider

2009-12-16 22:14

reporter   ~0033126

I analyzed that a bit more. The problem stems from TGtkListStoreStringList. A default TStringList adds items by checking where to insert them first (that would be Count if the list is unsorted and the "best match" [--> insert sort] when the list is sorted). Therefore TStringList.Add returns a valid index that is then used by TStrings.AddObject to set the correct object at that index.

TGtkListStoreStringList however always inserts at Count and the according Insert() procedure handles the actual sorting. That in turn causes Add() to return a possibly wrong index (it would only be correct if the new item was indeed appended and not inserted somewhere else).

A quick "hack" to circumvent that without restructuring the whole TGtkListStoreStringList is to also override the AddObject method:

function TGtkListStoreStringList.AddObject(const S: string; AObject: TObject
  ): Integer;
begin
  Insert(Count, S);
  Result := IndexOf(S);
  Objects[Result] := AObject;
end;

2009-12-16 23:14

 

gtk2int.diff (22,917 bytes)
Index: interfaces/gtk2/gtk2int.pas
===================================================================
--- interfaces/gtk2/gtk2int.pas	(Revision 23150)
+++ interfaces/gtk2/gtk2int.pas	(Arbeitskopie)
@@ -37,7 +37,7 @@
   Types, Classes, SysUtils, Math,
   {$IfNDef GTK2_2}
     {$IfDef HasX}
-     XLib, X, //XUtil,
+  XLib, X, //XUtil,
     {$EndIf}
   {$EndIf}
 
@@ -66,11 +66,13 @@
     procedure AppInit(var ScreenInfo: TScreenInfo); override;
     function AppHandle: THandle; override;
 
-    procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject; const ALCLObject: TObject; Direct: boolean);override;
-    procedure SetCommonCallbacks(const AGTKObject: PGTKObject; const ALCLObject: TObject); override;
+    procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject;
+      const ALCLObject: TObject; Direct: Boolean); override;
+    procedure SetCommonCallbacks(const AGTKObject: PGTKObject;
+      const ALCLObject: TObject); override;
     procedure SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String); override;
     procedure SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
-      MultiSelect, ExtendedSelect: boolean); override;
+      MultiSelect, ExtendedSelect: Boolean); override;
     procedure SetWidgetFont(const AWidget: PGtkWidget; const AFont: TFont); override;
 
     {$I gtk2winapih.inc}
@@ -81,46 +83,47 @@
 
   TGtkListStoreStringList = class(TStrings)
   private
-    FChangeStamp: integer;
-    FColumnIndex : Integer;
-    FGtkListStore : PGtkListStore;
+    FChangeStamp: Integer;
+    FColumnIndex: Integer;
+    FGtkListStore: PGtkListStore;
     FOwner: TWinControl;
-    FSorted : boolean;
+    FSorted: Boolean;
     FStates: TGtkListStringsStates;
-    FCachedCount: integer;
-    FCachedCapacity: integer;
-    FCachedSize: integer;
+    FCachedCount: Integer;
+    FCachedCapacity: Integer;
+    FCachedSize: Integer;
     FCachedItems: PGtkTreeIter;
-    FUpdateCount: integer;
+    FUpdateCount: Integer;
   protected
-    function GetCount : integer; override;
-    function Get(Index : Integer) : string; override;
+    function GetCount: Integer; override;
+    function Get(Index: Integer): String; override;
     function GetObject(Index: Integer): TObject; override;
-    procedure Put(Index: Integer; const S: string); override;
+    procedure Put(Index: Integer; const S: String); override;
     procedure PutObject(Index: Integer; AnObject: TObject); override;
-    procedure SetSorted(Val : boolean); virtual;
+    procedure SetSorted(Val: Boolean); virtual;
     procedure UpdateItemCache;
     procedure GrowCache;
     procedure ShrinkCache;
     procedure IncreaseChangeStamp;
   public
-    constructor Create(TheListStore : PGtkListStore;
-                       ColumnIndex : Integer; TheOwner: TWinControl);
+    constructor Create(TheListStore: PGtkListStore; ColumnIndex: Integer;
+      TheOwner: TWinControl);
     destructor Destroy; override;
-    function Add(const S: string): Integer; override;
-    procedure Assign(Source : TPersistent); override;
+    function Add(const S: String): Integer; override;
+    procedure Assign(Source: TPersistent); override;
     procedure Clear; override;
-    procedure Delete(Index : integer); override;
-    function IndexOf(const S: string): Integer; override;
-    procedure Insert(Index : integer; const S: string); override;
+    procedure Delete(Index: Integer); override;
+    function Find(const S: String; var Index: Integer): Boolean;
+    function IndexOf(const S: String): Integer; override;
+    procedure Insert(Index: Integer; const S: String); override;
     procedure Sort; virtual;
-    function IsEqual(List: TStrings): boolean;
+    function IsEqual(List: TStrings): Boolean;
     procedure BeginUpdate;
     procedure EndUpdate;
   public
-    property Sorted : boolean read FSorted write SetSorted;
+    property Sorted: Boolean read FSorted write SetSorted;
     property Owner: TWinControl read FOwner;
-    property ChangeStamp: integer read FChangeStamp;
+    property ChangeStamp: Integer read FChangeStamp;
   end;
 
 var
@@ -128,7 +131,7 @@
 
 
 implementation
-  
+
 uses
 {$ifdef Windows}
   Gtk2Windows,
@@ -136,7 +139,7 @@
   Gtk2WSFactory,
   Gtk2WSStdCtrls,
   Gtk2Themes,
-////////////////////////////////////////////////////
+  ////////////////////////////////////////////////////
   GtkProc,
   GtkDebug;
 
@@ -158,39 +161,44 @@
   Returns:
 
  ------------------------------------------------------------------------------}
-constructor TGtkListStoreStringList.Create(TheListStore : PGtkListStore;
-  ColumnIndex : Integer; TheOwner: TWinControl);
+constructor TGtkListStoreStringList.Create(TheListStore: PGtkListStore;
+  ColumnIndex: Integer; TheOwner: TWinControl);
 begin
   inherited Create;
-  if TheListStore = nil then RaiseGDBException(
-    'TGtkListStoreStringList.Create Unspecified list store');
-  fGtkListStore:=TheListStore;
+  if TheListStore = nil then
+    RaiseGDBException(
+      'TGtkListStoreStringList.Create Unspecified list store');
+  fGtkListStore := TheListStore;
 
-  if (ColumnIndex < 0) or
-    (ColumnIndex >= gtk_tree_model_get_n_columns(GTK_TREE_MODEL(fGtkListStore)))
-  then
+  if (ColumnIndex < 0) or (ColumnIndex >=
+    gtk_tree_model_get_n_columns(GTK_TREE_MODEL(fGtkListStore))) then
     RaiseGDBException('TGtkListStoreStringList.Create Invalid Column Index');
-  FColumnIndex:=ColumnIndex;
+  FColumnIndex := ColumnIndex;
 
-  if TheOwner = nil then RaiseGDBException(
-    'TGtkListStoreStringList.Create Unspecified owner');
-  FOwner:=TheOwner;
-  FStates:=[glsItemCacheNeedsUpdate,glsCountNeedsUpdate];
+  if TheOwner = nil then
+    RaiseGDBException(
+      'TGtkListStoreStringList.Create Unspecified owner');
+  FOwner := TheOwner;
+  FStates := [glsItemCacheNeedsUpdate, glsCountNeedsUpdate];
 end;
 
 destructor TGtkListStoreStringList.Destroy;
 begin
-  fGtkListStore:=nil;
+  fGtkListStore := nil;
   // don't destroy the widgets
-  ReAllocMem(FCachedItems,0);
+  ReAllocMem(FCachedItems, 0);
   inherited Destroy;
 end;
 
-function TGtkListStoreStringList.Add(const S: string): Integer;
+function TGtkListStoreStringList.Add(const S: String): Integer;
 begin
-  Result:=Count;
+  if FSorted then
+    Find(S, Result)
+  else
+    Result := Count;
+
   //DebugLn(['TGtkListStoreStringList.Add ',S,' Count=',Result]);
-  Insert(Count,S);
+  Insert(Result, S);
 end;
 
 {------------------------------------------------------------------------------
@@ -199,20 +207,24 @@
   Returns:
 
  ------------------------------------------------------------------------------}
-procedure TGtkListStoreStringList.SetSorted(Val : boolean);
+procedure TGtkListStoreStringList.SetSorted(Val: Boolean);
 var
   i: Integer;
 begin
-  if Val <> FSorted then begin
-    if Val then begin
-      for i:=0 to Count-2 do begin
-        if AnsiCompareText(Strings[i],Strings[i+1])<0 then begin
+  if Val <> FSorted then
+  begin
+    if Val then
+    begin
+      for i := 0 to Count - 2 do
+      begin
+        if AnsiCompareText(Strings[i], Strings[i + 1]) < 0 then
+        begin
           Sort;
-          break;
+          Break;
         end;
       end;
     end;
-    FSorted:= Val;
+    FSorted := Val;
   end;
 end;
 
@@ -223,51 +235,53 @@
 
 procedure TGtkListStoreStringList.UpdateItemCache;
 var
-  i: integer;
+  i: Integer;
 begin
-  if not (glsItemCacheNeedsUpdate in FStates) then exit;
+  if not (glsItemCacheNeedsUpdate in FStates) then
+    Exit;
   //DebugLn(['TGtkListStoreStringList.UpdateItemCache ']); DumpStack;
-  FCachedSize:=Count;
-  FCachedCapacity:=Count;
-  ReAllocMem(FCachedItems,SizeOf(TGtkTreeIter)*FCachedCapacity);
-  if FGtkListStore<>nil then
-    For I := 0 to FCachedSize - 1 do
+  FCachedSize := Count;
+  FCachedCapacity := Count;
+  ReAllocMem(FCachedItems, SizeOf(TGtkTreeIter) * FCachedCapacity);
+  if FGtkListStore <> nil then
+    for I := 0 to FCachedSize - 1 do
       gtk_tree_model_iter_nth_child(GTK_TREE_MODEL(FGtkListStore),
         @FCachedItems[i], nil, I);
-  Exclude(FStates,glsItemCacheNeedsUpdate);
+  Exclude(FStates, glsItemCacheNeedsUpdate);
 end;
 
 procedure TGtkListStoreStringList.GrowCache;
 begin
-  FCachedCapacity:=((FCachedCapacity*5) div 4)+10;
-  ReAllocMem(FCachedItems,SizeOf(TGtkTreeIter)*FCachedCapacity);
+  FCachedCapacity := ((FCachedCapacity * 5) div 4) + 10;
+  ReAllocMem(FCachedItems, SizeOf(TGtkTreeIter) * FCachedCapacity);
 end;
 
 procedure TGtkListStoreStringList.ShrinkCache;
 begin
-  FCachedCapacity:=FCachedSize+1;
-  ReAllocMem(FCachedItems,SizeOf(TGtkTreeIter)*FCachedCapacity);
+  FCachedCapacity := FCachedSize + 1;
+  ReAllocMem(FCachedItems, SizeOf(TGtkTreeIter) * FCachedCapacity);
 end;
 
 procedure TGtkListStoreStringList.IncreaseChangeStamp;
 begin
-  if FChangeStamp<High(FChangeStamp) then
-    inc(FChangeStamp)
+  if FChangeStamp < High(FChangeStamp) then
+    Inc(FChangeStamp)
   else
-    FChangeStamp:=Low(FChangeStamp);
+    FChangeStamp := Low(FChangeStamp);
 end;
 
 procedure TGtkListStoreStringList.PutObject(Index: Integer; AnObject: TObject);
 var
-  ListItem : TGtkTreeIter;
+  ListItem: TGtkTreeIter;
 begin
   if (Index < 0) or (Index >= Count) then
     RaiseGDBException('TGtkListStoreStringList.PutObject Out of bounds.')
-  else if FGtkListStore<>nil then begin
+  else if FGtkListStore <> nil then
+  begin
     UpdateItemCache;
-    ListItem:=FCachedItems[Index];
+    ListItem := FCachedItems[Index];
     gtk_list_store_set(FGtkListStore, @ListItem,
-                       [FColumnIndex+1, Pointer(AnObject), -1]);
+      [FColumnIndex + 1, Pointer(AnObject), -1]);
     IncreaseChangeStamp;
   end;
 end;
@@ -285,44 +299,48 @@
 begin
   BeginUpdate;
   // sort internally (sorting in the widget would be slow and unpretty ;)
-  sl:=TStringList.Create;
+  sl := TStringList.Create;
   sl.Assign(Self);
-  MergeSort(sl,@AnsiCompareText);
-  OldSorted:=Sorted;
-  FSorted:=false;
+  sl.Sort;
+  OldSorted := Sorted;
+  FSorted := False;
   Assign(sl);
-  FSorted:=OldSorted;
+  FSorted := OldSorted;
   sl.Free;
   EndUpdate;
 end;
 
-function TGtkListStoreStringList.IsEqual(List: TStrings): boolean;
+function TGtkListStoreStringList.IsEqual(List: TStrings): Boolean;
 var
-  i, Cnt: integer;
+  i, Cnt: Integer;
 begin
-  if List=Self then begin
-    Result:=true;
-    exit;
+  if List = Self then
+  begin
+    Result := True;
+    Exit;
   end;
-  Result:=false;
-  if List=nil then exit;
+  Result := False;
+  if List = nil then
+    Exit;
   BeginUpdate;
-  Cnt:=Count;
-  if (Cnt<>List.Count) then exit;
-  for i:=0 to Cnt-1 do
-    if (Strings[i]<>List[i]) or (Objects[i]<>List.Objects[i]) then exit;
-  Result:=true;
+  Cnt := Count;
+  if (Cnt <> List.Count) then
+    Exit;
+  for i := 0 to Cnt - 1 do
+    if (Strings[i] <> List[i]) or (Objects[i] <> List.Objects[i]) then
+      Exit;
+  Result := True;
   EndUpdate;
 end;
 
 procedure TGtkListStoreStringList.BeginUpdate;
 begin
-  inc(FUpdateCount);
+  Inc(FUpdateCount);
 end;
 
 procedure TGtkListStoreStringList.EndUpdate;
 begin
-  dec(FUpdateCount);
+  Dec(FUpdateCount);
 end;
 
 {------------------------------------------------------------------------------
@@ -331,46 +349,53 @@
   Returns:
 
  ------------------------------------------------------------------------------}
-procedure TGtkListStoreStringList.Assign(Source : TPersistent);
+procedure TGtkListStoreStringList.Assign(Source: TPersistent);
 var
-  i, Cnt: integer;
+  i, Cnt: Integer;
   CmpList: TStrings;
   OldSorted: Boolean;
 begin
-  if (Source=Self) or (Source=nil) then exit;
-  if ((Source is TGtkListStoreStringList)
-    and (TGtkListStoreStringList(Source).FGtkListStore=FGtkListStore))
-  then
+  if (Source = Self) or (Source = nil) then
+    Exit;
+  if ((Source is TGtkListStoreStringList) and
+    (TGtkListStoreStringList(Source).FGtkListStore = FGtkListStore)) then
     RaiseGDBException('TGtkListStoreStringList.Assign: There are 2 lists with the same FGtkListStore');
   BeginUpdate;
-  OldSorted:=Sorted;
-  CmpList:=nil;
+  OldSorted := Sorted;
+  CmpList := nil;
   try
-    if Source is TStrings then begin
+    if Source is TStrings then
+    begin
       // clearing and resetting can change other properties of the widget,
       // => don't change if the content is already the same
-      if Sorted then begin
-        CmpList:=TStringList.Create;
+      if Sorted then
+      begin
+        CmpList := TStringList.Create;
         CmpList.Assign(TStrings(Source));
-        MergeSort(TStringList(CmpList),@AnsiCompareText);
-      end else
-        CmpList:=TStrings(Source);
-      if IsEqual(CmpList) then exit;
+        TStringList(CmpList).Sort;
+      end
+      else
+        CmpList := TStrings(Source);
+      if IsEqual(CmpList) then
+        Exit;
       Clear;
-      FSorted:=false;
-      Cnt:=TStrings(Source).Count;
-      for i:=0 to Cnt - 1 do begin
-        AddObject(CmpList[i],CmpList.Objects[i]);
+      FSorted := False;
+      Cnt := TStrings(Source).Count;
+      for i := 0 to Cnt - 1 do
+      begin
+        AddObject(CmpList[i], CmpList.Objects[i]);
         //DebugLn(['TGtkListStoreStringList.Assign ',i,' ',CmpList[i],' ',Count]);
       end;
       // ToDo: restore other settings
 
       // Do not call inherited Assign as it does things we do not want to happen
-    end else
+    end
+    else
       inherited Assign(Source);
   finally
-    fSorted:=OldSorted;
-    if CmpList<>Source then CmpList.Free;
+    fSorted := OldSorted;
+    if CmpList <> Source then
+      CmpList.Free;
     EndUpdate;
   end;
 end;
@@ -381,52 +406,56 @@
   Returns:
 
  ------------------------------------------------------------------------------}
-function TGtkListStoreStringList.Get(Index : integer) : string;
+function TGtkListStoreStringList.Get(Index: Integer): String;
 var
-  Item : PChar;
-  ListItem : TGtkTreeIter;
+  Item: PChar;
+  ListItem: TGtkTreeIter;
 begin
   if (Index < 0) or (Index >= Count) then
     RaiseGDBException('TGtkListStoreStringList.Get Out of bounds.')
-  else begin
+  else
+  begin
     UpdateItemCache;
-    ListItem:=FCachedItems[Index];
+    ListItem := FCachedItems[Index];
 
     Item := nil;
     gtk_tree_model_get(GTK_TREE_MODEL(FGtkListStore), @ListItem,
-                       [FColumnIndex, @Item, -1]);
-    if (Item <> nil) then begin
-      Result:= StrPas(Item);
+      [FColumnIndex, @Item, -1]);
+    if (Item <> nil) then
+    begin
+      Result := StrPas(Item);
       g_free(Item);
     end
     else
-      result := '';
+      Result := '';
   end;
 end;
 
 function TGtkListStoreStringList.GetObject(Index: Integer): TObject;
 var
-  ListItem : TGtkTreeIter;
+  ListItem: TGtkTreeIter;
 begin
-  Result:=nil;
+  Result := nil;
   if (Index < 0) or (Index >= Count) then
     RaiseGDBException('TGtkListStoreStringList.GetObject Out of bounds.')
-  else if FGtkListStore<>nil then begin
+  else if FGtkListStore <> nil then
+  begin
     UpdateItemCache;
-    ListItem:=FCachedItems[Index];
-    gtk_tree_model_get(FGtkListStore, @ListItem, [FColumnIndex+1, @Result, -1]);
+    ListItem := FCachedItems[Index];
+    gtk_tree_model_get(FGtkListStore, @ListItem, [FColumnIndex + 1, @Result, -1]);
   end;
 end;
 
-procedure TGtkListStoreStringList.Put(Index: Integer; const S: string);
+procedure TGtkListStoreStringList.Put(Index: Integer; const S: String);
 var
-  ListItem : TGtkTreeIter;
+  ListItem: TGtkTreeIter;
 begin
   if (Index < 0) or (Index >= Count) then
     RaiseGDBException('TGtkListStoreStringList.Put Out of bounds.')
-  else if FGtkListStore<>nil then begin
+  else if FGtkListStore <> nil then
+  begin
     UpdateItemCache;
-    ListItem:=FCachedItems[Index];
+    ListItem := FCachedItems[Index];
     gtk_list_store_set(FGtkListStore, @ListItem, [FColumnIndex, PChar(S), -1]);
     IncreaseChangeStamp;
   end;
@@ -438,16 +467,17 @@
   Returns:
 
  ------------------------------------------------------------------------------}
-function TGtkListStoreStringList.GetCount: integer;
+function TGtkListStoreStringList.GetCount: Integer;
 begin
-  if (glsCountNeedsUpdate in FStates) then begin
-    if FGtkListStore<>nil then
-      FCachedCount:=gtk_tree_model_iter_n_children(GTK_TREE_MODEL(FGtkListStore),nil)
+  if (glsCountNeedsUpdate in FStates) then
+  begin
+    if FGtkListStore <> nil then
+      FCachedCount := gtk_tree_model_iter_n_children(GTK_TREE_MODEL(FGtkListStore), nil)
     else
-      FCachedCount:=0;
-    Exclude(FStates,glsCountNeedsUpdate);
+      FCachedCount := 0;
+    Exclude(FStates, glsCountNeedsUpdate);
   end;
-  Result:=FCachedCount;
+  Result := FCachedCount;
 end;
 
 {------------------------------------------------------------------------------
@@ -465,25 +495,26 @@
 
   //Lock the widget to avoid trigger events
   //Note: Assign/Clear is called inside CreateHandle before Handle is set
-  if FOwner.HandleAllocated then begin
+  if FOwner.HandleAllocated then
+  begin
     WidgetInfo := GetWidgetInfo(Pointer(FOwner.Handle), False);
     Inc(WidgetInfo^.ChangeLock);
-    
+
     gtk_list_store_clear(FGtkListStore);
 
     Dec(WidgetInfo^.ChangeLock);
     //Update the internal Index cache
     PInteger(WidgetInfo^.UserData)^ := -1;
   end;
-    
+
   IncreaseChangeStamp;
 
-  ReAllocMem(FCachedItems,0);
-  FCachedCapacity:=0;
-  FCachedSize:=0;
-  Exclude(FStates,glsItemCacheNeedsUpdate);
-  FCachedCount:=0;
-  Exclude(FStates,glsCountNeedsUpdate);
+  ReAllocMem(FCachedItems, 0);
+  FCachedCapacity := 0;
+  FCachedSize := 0;
+  Exclude(FStates, glsItemCacheNeedsUpdate);
+  FCachedCount := 0;
+  Exclude(FStates, glsCountNeedsUpdate);
 end;
 
 {------------------------------------------------------------------------------
@@ -492,7 +523,7 @@
   Returns:
 
  ------------------------------------------------------------------------------}
-procedure TGtkListStoreStringList.Delete(Index : integer);
+procedure TGtkListStoreStringList.Delete(Index: Integer);
 var
   ListItem: TGtkTreeIter;
   WidgetInfo: PWidgetInfo;
@@ -509,16 +540,17 @@
   gtk_list_store_remove(FGtkListStore, @ListItem);
   Dec(WidgetInfo^.ChangeLock);
   IncreaseChangeStamp;
-  
+
   if not (glsCountNeedsUpdate in FStates) then
-    dec(FCachedCount);
-  if (not (glsItemCacheNeedsUpdate in FStates)) and (Index=Count) then
+    Dec(FCachedCount);
+  if (not (glsItemCacheNeedsUpdate in FStates)) and (Index = Count) then
   begin
     // cache is valid and the last item was deleted -> just remove last item
-    dec(FCachedSize);
+    Dec(FCachedSize);
     if (FCachedSize < FCachedCapacity div 2) then
       ShrinkCache;
-  end else
+  end
+  else
     Include(FStates, glsItemCacheNeedsUpdate);
 
   if FOwner is TCustomComboBox then
@@ -529,32 +561,44 @@
   end;
 end;
 
-function TGtkListStoreStringList.IndexOf(const S: string): Integer;
+function TGtkListStoreStringList.Find(const S: String; var Index: Integer): Boolean;
 var
-  l, m, r, cmp: integer;
+  L, R, I: Integer;
+  CompareRes: Integer;
 begin
-  BeginUpdate;
-  if FSorted then begin
-    l:=0;
-    r:=Count-1;
-    m:=l;
-    while (l<=r) do begin
-      m:=(l+r) shr 1;
-      cmp:=AnsiCompareText(S,Strings[m]);
-
-      if cmp<0 then
-        r:=m-1
-      else if cmp>0 then
-        l:=m+1
-      else begin
-        Result:=m;
-        exit;
+  Result := False;
+  // Use binary search.
+  L := 0;
+  R := Count - 1;
+  while (L <= R) do
+  begin
+    I := L + (R - L) div 2;
+    CompareRes := AnsiCompareText(S, Strings[I]);
+    if (CompareRes > 0) then
+      L := I + 1
+    else
+    begin
+      R := I - 1;
+      if (CompareRes = 0) then
+      begin
+        Result := True;
+        L := I; // forces end of while loop
       end;
     end;
-    Result:=-1;
-  end else begin
-    Result:=inherited IndexOf(S);
   end;
+  Index := L;
+end;
+
+function TGtkListStoreStringList.IndexOf(const S: String): Integer;
+begin
+  BeginUpdate;
+  if FSorted then
+  begin
+    //Binary Search
+    if not Find(S, Result) then
+      Result := -1;
+  end else
+    Result := inherited IndexOf(S);
   EndUpdate;
 end;
 
@@ -564,12 +608,12 @@
   Returns:
 
  ------------------------------------------------------------------------------}
-procedure TGtkListStoreStringList.Insert(Index : integer; const S : string);
+procedure TGtkListStoreStringList.Insert(Index: Integer; const S: String);
 var
-  li : TGtkTreeIter;
-  l, m, r, cmp: integer;
+  li: TGtkTreeIter;
+  l, m, r, cmp: Integer;
   LCLIndex: PInteger;
-  
+
   {procedure TestNewItem;
   var
     Item: PChar;
@@ -590,36 +634,20 @@
     else
       DebugLn(['TestNewItem FAILED: new item missing']);
   end;}
-  
+
 begin
   BeginUpdate;
   try
-    if FSorted then begin
-      l:=0;
-      r:=Count-1;
-      m:=l;
-      while (l<=r) do begin
-        m:=(l+r) shr 1;
-        cmp:=AnsiCompareText(S,Strings[m]);
-        if cmp<0 then
-          r:=m-1
-        else if cmp>0 then
-          l:=m+1
-        else
-          break;
-      end;
-      if (m<Count) and (AnsiCompareText(S,Strings[m])>0) then
-        inc(m);
-      Index:=m;
-    end;
     if (Index < 0) or (Index > Count) then
-      RaiseGDBException('TGtkListStoreStringList.Insert: Index '+IntToStr(Index)
-        +' out of bounds. Count='+IntToStr(Count));
-    if Owner = nil then RaiseGDBException(
-      'TGtkListStoreStringList.Insert Unspecified owner');
+      RaiseGDBException('TGtkListStoreStringList.Insert: Index ' +
+        IntToStr(Index) + ' out of bounds. Count=' + IntToStr(Count));
+    if Owner = nil then
+      RaiseGDBException(
+        'TGtkListStoreStringList.Insert Unspecified owner');
 
     // this call is few times faster than gtk_list_store_insert, gtk_list_store_set
-    gtk_list_store_insert_with_values(FGtkListStore, @li, Index, FColumnIndex, PChar(S), -1);
+    gtk_list_store_insert_with_values(FGtkListStore, @li, Index,
+      FColumnIndex, PChar(S), -1);
     IncreaseChangeStamp;
 
     //if the item is inserted before the selected item the
@@ -634,17 +662,20 @@
     // ToDo: connect callbacks
 
     if not (glsCountNeedsUpdate in FStates) then
-      inc(FCachedCount);
+      Inc(FCachedCount);
 
-    if (not (glsItemCacheNeedsUpdate in FStates)) and (Index=Count-1) then begin
+    if (not (glsItemCacheNeedsUpdate in FStates)) and (Index = Count - 1) then
+    begin
       // cache is valid and item was added as last
       // Add item to cache (instead of updating the whole cache)
       // This accelerates Assign.
-      if FCachedSize=FCachedCapacity then GrowCache;
-      FCachedItems[FCachedSize]:=li;
-      inc(FCachedSize);
-    end else
-      Include(FStates,glsItemCacheNeedsUpdate);
+      if FCachedSize = FCachedCapacity then
+        GrowCache;
+      FCachedItems[FCachedSize] := li;
+      Inc(FCachedSize);
+    end
+    else
+      Include(FStates, glsItemCacheNeedsUpdate);
 
     //TestNewItem;
   finally
@@ -653,3 +684,4 @@
 end;
 
 end.
+
gtk2int.diff (22,917 bytes)

Andreas Schneider

2009-12-16 23:18

reporter   ~0033128

Ok I took the time and implemented it "proper". That is I used the Find method from TStringList to move the calculation of the index from Insert() to Add(). I also use that Find to perform IndexOf() (which used slightly redundant code until now).
Further I removed both references to MergeSort() since in both cases it was used to sort TStringList which already implements QuickSort.

I hope I didn't insult anybody by also reformatting the source code, but it was a mess ... there were at least two different code styles within that single file.

Vincent Snijders

2009-12-17 14:20

manager   ~0033147

Target set to 0.9.30, so the patch can be reviewed before next release.

Marc Weustink

2010-01-02 19:39

administrator   ~0033435

Thanks for the patch. Please provide code reformatting in a separate patch. Most of the formatting is applied in r23346

Issue History

Date Modified Username Field Change
2008-08-21 18:40 mittag New Issue
2008-08-21 18:40 mittag Widgetset => GTK 2
2008-08-21 19:41 Vincent Snijders LazTarget => 1.2
2008-08-21 19:41 Vincent Snijders Note Added: 0021573
2008-08-21 19:41 Vincent Snijders Status new => feedback
2008-08-21 20:01 Michael Van Canneyt Note Added: 0021574
2008-08-21 22:51 Vincent Snijders LazTarget 1.2 => 1.0
2008-08-21 22:51 Vincent Snijders Status feedback => acknowledged
2008-08-21 22:51 Vincent Snijders Target Version => 1.0.0
2008-08-21 22:51 Vincent Snijders Widgetset GTK 2 => GTK, GTK 2
2008-08-22 10:13 mittag Note Added: 0021590
2009-12-16 21:12 Andreas Schneider File Added: Laz_CB_Testcase.tar.gz
2009-12-16 21:12 Andreas Schneider Note Added: 0033125
2009-12-16 22:14 Andreas Schneider Note Added: 0033126
2009-12-16 23:14 Andreas Schneider File Added: gtk2int.diff
2009-12-16 23:18 Andreas Schneider Note Added: 0033128
2009-12-17 14:19 Vincent Snijders Relationship added related to 0015356
2009-12-17 14:20 Vincent Snijders LazTarget 1.0 => 0.9.30
2009-12-17 14:20 Vincent Snijders Note Added: 0033147
2009-12-17 14:20 Vincent Snijders Target Version 1.0.0 => 0.9.30
2009-12-24 00:41 Marc Weustink Status acknowledged => assigned
2009-12-24 00:41 Marc Weustink Assigned To => Marc Weustink
2010-01-02 19:39 Marc Weustink Fixed in Revision => 23347
2010-01-02 19:39 Marc Weustink Status assigned => resolved
2010-01-02 19:39 Marc Weustink Resolution open => fixed
2010-01-02 19:39 Marc Weustink Note Added: 0033435
2010-01-02 20:09 Marc Weustink Fixed in Version => 0.9.29 (SVN)
2011-12-01 11:22 Marc Weustink Status resolved => closed