Browse Source

classes: add TStrings.Options (Delphi-compatibility)

git-svn-id: trunk@43841 -
ondrej 5 years ago
parent
commit
5d58ced92b
2 changed files with 92 additions and 31 deletions
  1. 14 6
      rtl/objpas/classes/classesh.inc
  2. 78 25
      rtl/objpas/classes/stringl.inc

+ 14 - 6
rtl/objpas/classes/classesh.inc

@@ -610,6 +610,8 @@ type
   TStringsForEachMethod = procedure(const CurrentValue: string) of object;
   TMissingNameValueSeparatorAction = (mnvaValue,mnvaName,mnvaEmpty,mnvaError);
   TMissingNameValueSeparatorActions = set of TMissingNameValueSeparatorAction;
+  TStringsOption = (soStrictDelimiter,soWriteBOM,soTrailingLineBreak,soUseLocale);
+  TStringsOptions = set of TStringsOption;
 
   TStrings = class(TPersistent)
   private
@@ -624,16 +626,17 @@ type
     FUpdateCount: Integer;
     FAdapter: IStringsAdapter;
     FLBS : TTextLineBreakStyle;
-    FSkipLastLineBreak : Boolean;
-    FStrictDelimiter : Boolean;
+    FOptions : TStringsOptions;
     FLineBreak : String;
-    FWriteBOM: Boolean;
     function GetCommaText: string;
     function GetLineBreakCharLBS: string;
     function GetMissingNameValueSeparatorAction: TMissingNameValueSeparatorAction;
     function GetName(Index: Integer): string;
+    function GetStrictDelimiter: Boolean;
     function GetTrailingLineBreak: Boolean;
+    function GetUseLocale: Boolean;
     function GetValue(const Name: string): string;
+    function GetWriteBOM: Boolean;
     Function GetLBS : TTextLineBreakStyle;
     procedure SetDefaultEncoding(const ADefaultEncoding: TEncoding);
     procedure SetEncoding(const AEncoding: TEncoding);
@@ -642,7 +645,10 @@ type
     procedure SetCommaText(const Value: string);
     procedure SetMissingNameValueSeparatorAction(AValue: TMissingNameValueSeparatorAction);
     procedure SetStringsAdapter(const Value: IStringsAdapter);
+    procedure SetStrictDelimiter(AValue: Boolean);
     procedure SetTrailingLineBreak(AValue: Boolean);
+    procedure SetUseLocale(AValue: Boolean);
+    procedure SetWriteBOM(AValue: Boolean);
     procedure SetValue(const Name, Value: string);
     procedure SetDelimiter(c:Char);
     procedure SetQuoteChar(c:Char);
@@ -658,6 +664,7 @@ type
     procedure SetSkipLastLineBreak(const AValue : Boolean);
     Procedure DoSetDelimitedText(const AValue: string; DoClear,aStrictDelimiter : Boolean; aQuoteChar,aDelimiter : Char);
   protected
+    function CompareStrings(const s1,s2 : string) : Integer; virtual;
     procedure DefineProperties(Filer: TFiler); override;
     procedure Error(const Msg: string; Data: Integer);
     procedure Error(const Msg: pstring; Data: Integer);
@@ -763,18 +770,20 @@ type
     property Names[Index: Integer]: string read GetName;
     Property NameValueSeparator : Char Read GetNameValueSeparator Write SetNameValueSeparator;
     property Objects[Index: Integer]: TObject read GetObject write PutObject;
+    property Options: TStringsOptions read FOptions write FOptions;
     property QuoteChar: Char read GetQuoteChar write SetQuoteChar;
     Property SkipLastLineBreak : Boolean Read GetSkipLastLineBreak Write SetSkipLastLineBreak;
     // Same as SkipLastLineBreak but for Delphi compatibility. Note it has opposite meaning.
     Property TrailingLineBreak : Boolean Read GetTrailingLineBreak Write SetTrailingLineBreak;
-    Property StrictDelimiter : Boolean Read FStrictDelimiter Write FStrictDelimiter;
+    Property StrictDelimiter : Boolean Read GetStrictDelimiter Write SetStrictDelimiter;
     property Strings[Index: Integer]: string read Get write Put; default;
     property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
     property Text: string read GetTextStr write SetTextStr;
     Property TextLineBreakStyle : TTextLineBreakStyle Read GetLBS Write SetLBS;
+    Property UseLocale : Boolean Read GetUseLocale Write SetUseLocale;
     property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex;
     property Values[const Name: string]: string read GetValue write SetValue;
-    property WriteBOM: Boolean read FWriteBOM write FWriteBOM;
+    property WriteBOM: Boolean read GetWriteBOM write SetWriteBOM;
   end;
   TStringsClass = Class of TStrings;
 
@@ -833,7 +842,6 @@ type
     procedure InsertItem(Index: Integer; const S: string); virtual;
     procedure InsertItem(Index: Integer; const S: string; O: TObject); virtual;
     Function DoCompareText(const s1,s2 : string) : PtrInt; override;
-    function CompareStrings(const s1,s2 : string) : Integer; virtual;
 
   public
     destructor Destroy; override;

+ 78 - 25
rtl/objpas/classes/stringl.inc

@@ -83,15 +83,13 @@ end;
 Function TStrings.GetSkipLastLineBreak : Boolean;
 
 begin
-  CheckSpecialChars;
-  Result:=FSkipLastLineBreak;
+  Result:=not TrailingLineBreak;
 end;
 
 procedure TStrings.SetSkipLastLineBreak(const AValue : Boolean);
 
 begin
-  CheckSpecialChars;
-  FSkipLastLineBreak:=AValue;
+  TrailingLineBreak:=not AValue;
 end;
 
 Function TStrings.GetLBS : TTextLineBreakStyle;
@@ -459,9 +457,24 @@ begin
   GetNameValue(Index,Result,V);
 end;
 
+function TStrings.GetStrictDelimiter: Boolean;
+begin
+  Result:=soStrictDelimiter in FOptions;
+end;
+
 function TStrings.GetTrailingLineBreak: Boolean;
 begin
-  Result:=Not SkipLastLineBreak;
+  Result:=soTrailingLineBreak in FOptions;
+end;
+
+function TStrings.GetUseLocale: Boolean;
+begin
+  Result:=soUseLocale in FOptions;
+end;
+
+function TStrings.GetWriteBOM: Boolean;
+begin
+  Result:=soWriteBOM in FOptions;
 end;
 
 Function TStrings.GetValue(const Name: string): string;
@@ -519,7 +532,7 @@ Procedure TStrings.SetDelimitedText(const AValue: string);
 
 begin
   CheckSpecialChars;
-  DoSetDelimitedText(aValue,True,FStrictDelimiter,FQuoteChar,FDelimiter);
+  DoSetDelimitedText(aValue,True,StrictDelimiter,FQuoteChar,FDelimiter);
 end;
 
 Procedure TStrings.DoSetDelimitedText(const AValue: string; DoClear,aStrictDelimiter : Boolean; aQuoteChar,aDelimiter : Char);
@@ -652,9 +665,36 @@ Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter);
 begin
 end;
 
+procedure TStrings.SetStrictDelimiter(AValue: Boolean);
+begin
+  if AValue then
+    Include(FOptions,soStrictDelimiter)
+  else
+    Exclude(FOptions,soStrictDelimiter);
+end;
+
 procedure TStrings.SetTrailingLineBreak(AValue: Boolean);
 begin
-  SkipLastLineBreak:=Not aValue;
+  if AValue then
+    Include(FOptions,soTrailingLineBreak)
+  else
+    Exclude(FOptions,soTrailingLineBreak);
+end;
+
+procedure TStrings.SetUseLocale(AValue: Boolean);
+begin
+  if AValue then
+    Include(FOptions,soUseLocale)
+  else
+    Exclude(FOptions,soUseLocale);
+end;
+
+procedure TStrings.SetWriteBOM(AValue: Boolean);
+begin
+  if AValue then
+    Include(FOptions,soWriteBOM)
+  else
+    Exclude(FOptions,soWriteBOM);
 end;
 
 
@@ -701,6 +741,13 @@ end;
 
 
 
+function TStrings.CompareStrings(const s1,s2 : string) : Integer;
+begin
+  Result := DoCompareText(s1, s2);
+end;
+
+
+
 procedure TStrings.DefineProperties(Filer: TFiler);
 var
   HasData: Boolean;
@@ -758,7 +805,7 @@ begin
   NLS:=Length(NL);
   For I:=0 to count-1 do
     L:=L+Length(Strings[I])+NLS;
-  if FSkipLastLineBreak then
+  if SkipLastLineBreak then
     Dec(L,NLS);
   Setlength(Result,L);
   P:=Pointer(Result);
@@ -769,7 +816,7 @@ begin
     if L<>0 then
       System.Move(Pointer(S)^,P^,L);
     P:=P+L;
-    if (I<Count-1) or Not FSkipLastLineBreak then
+    if (I<Count-1) or Not SkipLastLineBreak then
       For L:=1 to NLS do
         begin
         P^:=NL[L];
@@ -951,7 +998,7 @@ end;
 procedure TStrings.AddDelimitedText(const S: String);
 begin
   CheckSpecialChars;
-  DoSetDelimitedText(S,False,FStrictDelimiter,FQuoteChar,FDelimiter);
+  DoSetDelimitedText(S,False,StrictDelimiter,FQuoteChar,FDelimiter);
 end;
 
 Procedure TStrings.SetUpdateState(Updating: Boolean);
@@ -977,7 +1024,7 @@ begin
   inherited Create;
   FDefaultEncoding:=TEncoding.Default;
   FEncoding:=nil;
-  FWriteBOM:=True;
+  FOptions := [soWriteBOM,soTrailingLineBreak,soUseLocale];
   FAlwaysQuote:=False;
 end;
 
@@ -1091,7 +1138,7 @@ begin
       FNameValueSeparator:=S.FNameValueSeparator;
       FLBS:=S.FLBS;
       FLineBreak:=S.FLineBreak;
-      FWriteBOM:=S.FWriteBOM;
+      FOptions:=S.FOptions;
       DefaultEncoding:=S.DefaultEncoding;
       SetEncoding(S.Encoding);
       AddStrings(S);
@@ -1186,7 +1233,10 @@ end;
 
 Function TStrings.DoCompareText(const s1,s2 : string) : PtrInt;
   begin
-    result:=CompareText(s1,s2);
+    if UseLocale then
+      result:=AnsiCompareText(s1,s2)
+    else
+      result:=CompareText(s1,s2);
   end;
 
 
@@ -1489,7 +1539,7 @@ begin
     L:=Length(S);
     if L<>0 then
       Stream.WriteBuffer(S[1], L*SizeOf(Char));
-    if (I<Count-1) or Not FSkipLastLineBreak then
+    if (I<Count-1) or Not SkipLastLineBreak then
       Stream.WriteBuffer(NL[1], NLS);
     end;
 end;
@@ -1506,7 +1556,7 @@ Var B,BNL : TBytes;
 begin
   if AEncoding=nil then
     AEncoding:=FDefaultEncoding;
-  if FWriteBOM then
+  if WriteBOM then
     begin
       B:=AEncoding.GetPreamble;
       if Length(B)>0 then
@@ -1524,7 +1574,7 @@ begin
       B:=AEncoding.GetAnsiBytes(S);
       Stream.WriteBuffer(B[0],Length(B));
       end;
-    if (I<Count-1) or Not FSkipLastLineBreak then
+    if (I<Count-1) or Not SkipLastLineBreak then
       Stream.WriteBuffer(BNL[0],BNLS);
     end;
 end;
@@ -1884,15 +1934,18 @@ 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;
-begin
-  Result := DoCompareText(s1, s2);
+  begin
+    if UseLocale then
+      result:=AnsiCompareStr(s1,s2)
+    else
+      result:=CompareStr(s1,s2);
+  end else
+  begin
+    if UseLocale then
+      result:=AnsiCompareText(s1,s2)
+    else
+      result:=CompareText(s1,s2);
+  end;
 end;