* Allow Find to work with user-sorted stringlists.

git-svn-id: trunk@33328 -

rtl/objpas/classes/classesh.inc

@@ -726,6 +726,9 @@ type
   PStringItemList = ^TStringItemList;
   TStringItemList = array[0..MaxListSize] of TStringItem;
 
+  TStringsSortStyle = (sslNone,sslUser,sslAuto);
+  TStringsSortStyles = Set of TStringsSortStyle;
+
   TStringList = class(TStrings)
   private
     FList: PStringItemList;
@@ -735,15 +738,17 @@ type
     FOnChanging: TNotifyEvent;
     FDuplicates: TDuplicates;
     FCaseSensitive : Boolean;
-    FSorted: Boolean;
     FForceSort : Boolean;
     FOwnsObjects : Boolean;
+    FSortStyle: TStringsSortStyle;
     procedure ExchangeItemsInt(Index1, Index2: Integer); inline;
+    function GetSorted: Boolean;
     procedure Grow;
     procedure InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False);
     procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
     procedure SetSorted(Value: Boolean);
     procedure SetCaseSensitive(b : boolean);
+    procedure SetSortStyle(AValue: TStringsSortStyle);
   protected
     procedure ExchangeItems(Index1, Index2: Integer); virtual;
     procedure Changed; virtual;
@@ -773,11 +778,12 @@ type
     procedure Sort; virtual;
     procedure CustomSort(CompareFn: TStringListSortCompare); virtual;
     property Duplicates: TDuplicates read FDuplicates write FDuplicates;
-    property Sorted: Boolean read FSorted write SetSorted;
+    property Sorted: Boolean read GetSorted write SetSorted;
     property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
     property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
     property OwnsObjects : boolean read FOwnsObjects write FOwnsObjects;
+    Property SortStyle : TStringsSortStyle Read FSortStyle Write SetSortStyle;
   end;
 
 {$else}

rtl/objpas/classes/stringl.inc

@@ -1043,7 +1043,7 @@ end;
 
 {$if not defined(FPC_TESTGENERICS)}
 
-Procedure TStringList.ExchangeItemsInt(Index1, Index2: Integer);
+procedure TStringList.ExchangeItemsInt(Index1, Index2: Integer);
 
 Var P1,P2 : Pointer;
 
@@ -1056,14 +1056,19 @@ begin
   Pointer(Flist^[Index2].FObject):=P2;
 end;
 
+function TStringList.GetSorted: Boolean;
+begin
+  Result:=FSortStyle in [sslUser,sslAuto];
+end;
+
 
-Procedure TStringList.ExchangeItems(Index1, Index2: Integer);
+procedure TStringList.ExchangeItems(Index1, Index2: Integer);
 begin
   ExchangeItemsInt(Index1, Index2);
 end;
 
 
-Procedure TStringList.Grow;
+procedure TStringList.Grow;
 
 Var
   NC : Integer;
@@ -1079,7 +1084,7 @@ begin
   SetCapacity(NC);
 end;
 
-Procedure TStringList.InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False);
+procedure TStringList.InternalClear(FromIndex: Integer; ClearOnly: Boolean);
 
 Var
   I: Integer;
@@ -1106,7 +1111,8 @@ begin
     SetCapacity(0);
 end;
 
-Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
+procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare
+  );
 var
   Pivot, vL, vR: Integer;
   ExchangeProc: procedure(Left, Right: Integer) of object;
@@ -1152,13 +1158,13 @@ begin
 end;
 
 
-Procedure TStringList.InsertItem(Index: Integer; const S: string);
+procedure TStringList.InsertItem(Index: Integer; const S: string);
 begin
   InsertItem(Index, S, nil);
 end;
 
 
-Procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject);
+procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject);
 begin
   Changing;
   If FCount=Fcapacity then Grow;
@@ -1173,19 +1179,18 @@ begin
 end;
 
 
-Procedure TStringList.SetSorted(Value: Boolean);
+procedure TStringList.SetSorted(Value: Boolean);
 
 begin
-  If FSorted<>Value then
-    begin
-    If Value then sort;
-    FSorted:=VAlue
-    end;
+  If Value then
+    SortStyle:=sslAuto
+  else
+    SortStyle:=sslNone
 end;
 
 
 
-Procedure TStringList.Changed;
+procedure TStringList.Changed;
 
 begin
   If (FUpdateCount=0) Then
@@ -1198,7 +1203,7 @@ end;
 
 
 
-Procedure TStringList.Changing;
+procedure TStringList.Changing;
 
 begin
   If FUpdateCount=0 then
@@ -1208,7 +1213,7 @@ end;
 
 
 
-Function TStringList.Get(Index: Integer): string;
+function TStringList.Get(Index: Integer): string;
 
 begin
   If (Index<0) or (INdex>=Fcount)  then
@@ -1218,7 +1223,7 @@ end;
 
 
 
-Function TStringList.GetCapacity: Integer;
+function TStringList.GetCapacity: Integer;
 
 begin
   Result:=FCapacity;
@@ -1226,7 +1231,7 @@ end;
 
 
 
-Function TStringList.GetCount: Integer;
+function TStringList.GetCount: Integer;
 
 begin
   Result:=FCount;
@@ -1234,7 +1239,7 @@ end;
 
 
 
-Function TStringList.GetObject(Index: Integer): TObject;
+function TStringList.GetObject(Index: Integer): TObject;
 
 begin
   If (Index<0) or (INdex>=Fcount)  then
@@ -1244,7 +1249,7 @@ end;
 
 
 
-Procedure TStringList.Put(Index: Integer; const S: string);
+procedure TStringList.Put(Index: Integer; const S: string);
 
 begin
   If Sorted then
@@ -1258,7 +1263,7 @@ end;
 
 
 
-Procedure TStringList.PutObject(Index: Integer; AObject: TObject);
+procedure TStringList.PutObject(Index: Integer; AObject: TObject);
 
 begin
   If (Index<0) or (INdex>=Fcount)  then
@@ -1270,7 +1275,7 @@ end;
 
 
 
-Procedure TStringList.SetCapacity(NewCapacity: Integer);
+procedure TStringList.SetCapacity(NewCapacity: Integer);
 
 Var NewList : Pointer;
     MSize : Longint;
@@ -1315,7 +1320,7 @@ end;
 
 
 
-Procedure TStringList.SetUpdateState(Updating: Boolean);
+procedure TStringList.SetUpdateState(Updating: Boolean);
 
 begin
   If Updating then
@@ -1335,10 +1340,10 @@ end;
 
 
 
-Function TStringList.Add(const S: string): Integer;
+function TStringList.Add(const S: string): Integer;
 
 begin
-  If Not Sorted then
+  If Not (SortStyle=sslAuto) then
     Result:=FCount
   else
     If Find (S,Result) then
@@ -1349,7 +1354,7 @@ begin
    InsertItem (Result,S);
 end;
 
-Procedure TStringList.Clear;
+procedure TStringList.Clear;
 
 begin
   if FCount = 0 then Exit;
@@ -1358,7 +1363,7 @@ begin
   Changed;
 end;
 
-Procedure TStringList.Delete(Index: Integer);
+procedure TStringList.Delete(Index: Integer);
 
 begin
   If (Index<0) or (Index>=FCount) then
@@ -1377,7 +1382,7 @@ end;
 
 
 
-Procedure TStringList.Exchange(Index1, Index2: Integer);
+procedure TStringList.Exchange(Index1, Index2: Integer);
 
 begin
   If (Index1<0) or (Index1>=FCount) then
@@ -1395,22 +1400,33 @@ begin
   if b=FCaseSensitive then
     Exit;
   FCaseSensitive:=b;
-  if FSorted then
+  if FSortStyle=sslAuto then
     begin
     FForceSort:=True;
-    sort;
-    FForceSort:=False;
+    try
+      Sort;
+    finally
+      FForceSort:=False;
     end;
+    end;
+end;
+
+procedure TStringList.SetSortStyle(AValue: TStringsSortStyle);
+begin
+  if FSortStyle=AValue then Exit;
+  if (AValue=sslAuto) then
+    Sort;
+  FSortStyle:=AValue;
 end;
 
 
-Function TStringList.DoCompareText(const s1,s2 : string) : PtrInt;
-  begin
-        if FCaseSensitive then
-          result:=AnsiCompareStr(s1,s2)
-        else
-          result:=AnsiCompareText(s1,s2);
-  end;
+function TStringList.DoCompareText(const s1, s2: string): PtrInt;
+begin
+  if FCaseSensitive then
+    result:=AnsiCompareStr(s1,s2)
+  else
+    result:=AnsiCompareText(s1,s2);
+end;
 
 
 function TStringList.CompareStrings(const s1,s2 : string) : Integer;
@@ -1419,15 +1435,16 @@ begin
 end;
 
 
-Function TStringList.Find(const S: string; Out Index: Integer): Boolean;
+function TStringList.Find(const S: string; out Index: Integer): Boolean;
 
 var
   L, R, I: Integer;
   CompareRes: PtrInt;
 begin
   Result := false;
-  if Not Sorted then 
-    exit;
+  Index:=-1;
+  if Not Sorted then
+    Raise EListError.Create(SErrFindNeedsSortedList);
   // Use binary search.
   L := 0;
   R := Count - 1;
@@ -1451,7 +1468,7 @@ end;
 
 
 
-Function TStringList.IndexOf(const S: string): Integer;
+function TStringList.IndexOf(const S: string): Integer;
 
 begin
   If Not Sorted then
@@ -1464,10 +1481,10 @@ end;
 
 
 
-Procedure TStringList.Insert(Index: Integer; const S: string);
+procedure TStringList.Insert(Index: Integer; const S: string);
 
 begin
-  If Sorted then
+  If SortStyle=sslAuto then
     Error (SSortedListError,0)
   else
     If (Index<0) or (Index>FCount) then
@@ -1477,10 +1494,10 @@ begin
 end;
 
 
-Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
+procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
 
 begin
-  If (FForceSort or (Not Sorted)) and (FCount>1) then
+  If (FForceSort or (Not (FSortStyle=sslAuto))) and (FCount>1) then
     begin
     Changing;
     QuickSort(0,FCount-1, CompareFn);
@@ -1495,7 +1512,7 @@ begin
     List.FList^[Index].FString);
 end;
 
-Procedure TStringList.Sort;
+procedure TStringList.Sort;
 
 begin
   CustomSort(@StringListAnsiCompare);