Source/TntFormatStrUtils.pas

   1
   2 {*****************************************************************************}
   3 {                                                                             }
   4 {    Tnt Delphi Unicode Controls                                              }
   5 {      http://www.tntware.com/delphicontrols/unicode/                         }
   6 {        Version: 2.3.0                                                       }
   7 {                                                                             }
   8 {    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
   9 {                                                                             }
  10 {*****************************************************************************}
  11
  12 unit TntFormatStrUtils;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 // this unit provides functions to work with format strings
  19
  20 uses
  21   TntSysUtils;
  22
  23 function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
  24 {$IFNDEF COMPILER_9_UP}
  25 function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
  26   const Args: array of const
  27     {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
  28 {$ENDIF}
  29 procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
  30 function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
  31
  32 type
  33   EFormatSpecError = class(ETntGeneralError);
  34
  35 implementation
  36
  37 uses
  38   SysUtils, Math, TntClasses;
  39
  40 resourcestring
  41   SInvalidFormatSpecifier = 'Invalid Format Specifier: %s';
  42   SMismatchedArgumentTypes = 'Argument types for index %d do not match. (%s <> %s)';
  43   SMismatchedArgumentCounts = 'Number of format specifiers do not match.';
  44
  45 type
  46   TFormatSpecifierType = (fstInteger, fstFloating, fstPointer, fstString);
  47
  48 function GetFormatSpecifierType(const FormatSpecifier: WideString): TFormatSpecifierType;
  49 var
  50   LastChar: WideChar;
  51 begin
  52   LastChar := TntWideLastChar(FormatSpecifier);
  53   case LastChar of
  54     'd', 'D', 'u', 'U', 'x', 'X':
  55       result := fstInteger;
  56     'e', 'E', 'f', 'F', 'g', 'G', 'n', 'N', 'm', 'M':
  57       result := fstFloating;
  58     'p', 'P':
  59       result := fstPointer;
  60     's', 'S':
  61       result := fstString
  62     else
  63       raise ETntInternalError.CreateFmt('Internal Error: Unexpected format type (%s)', [LastChar]);
  64   end;
  65 end;
  66
  67 type
  68   TFormatStrParser = class(TObject)
  69   private
  70     ParsedString: TBufferedWideString;
  71     PFormatString: PWideChar;
  72     LastIndex: Integer;
  73     ExplicitCount: Integer;
  74     ImplicitCount: Integer;
  75     procedure RaiseInvalidFormatSpecifier;
  76     function ParseChar(c: WideChar): Boolean;
  77     procedure ForceParseChar(c: WideChar);
  78     function ParseDigit: Boolean;
  79     function ParseInteger: Boolean;
  80     procedure ForceParseType;
  81     function PeekDigit: Boolean;
  82     function PeekIndexSpecifier(out Index: Integer): Boolean;
  83   public
  84     constructor Create(const _FormatString: WideString);
  85     destructor Destroy; override;
  86     function ParseFormatSpecifier: Boolean;
  87   end;
  88
  89 constructor TFormatStrParser.Create(const _FormatString: WideString);
  90 begin
  91   inherited Create;
  92   PFormatString := PWideChar(_FormatString);
  93   ExplicitCount := 0;
  94   ImplicitCount := 0;
  95   LastIndex := -1;
  96   ParsedString := TBufferedWideString.Create;
  97 end;
  98
  99 destructor TFormatStrParser.Destroy;
 100 begin
 101   FreeAndNil(ParsedString);
 102   inherited;
 103 end;
 104
 105 procedure TFormatStrParser.RaiseInvalidFormatSpecifier;
 106 begin
 107   raise EFormatSpecError.CreateFmt(SInvalidFormatSpecifier, [ParsedString.Value + PFormatString]);
 108 end;
 109
 110 function TFormatStrParser.ParseChar(c: WideChar): Boolean;
 111 begin
 112   result := False;
 113   if PFormatString^ = c then begin
 114     result := True;
 115     ParsedString.AddChar(c);
 116     Inc(PFormatString);
 117   end;
 118 end;
 119
 120 procedure TFormatStrParser.ForceParseChar(c: WideChar);
 121 begin
 122   if not ParseChar(c) then
 123     RaiseInvalidFormatSpecifier;
 124 end;
 125
 126 function TFormatStrParser.PeekDigit: Boolean;
 127 begin
 128   result := False;
 129   if  (PFormatString^ <> #0)
 130   and (PFormatString^ >= '0')
 131   and (PFormatString^ <= '9') then
 132     result := True;
 133 end;
 134
 135 function TFormatStrParser.ParseDigit: Boolean;
 136 begin
 137   result := False;
 138   if PeekDigit then begin
 139     result := True;
 140     ForceParseChar(PFormatString^);
 141   end;
 142 end;
 143
 144 function TFormatStrParser.ParseInteger: Boolean;
 145 const
 146   MAX_INT_DIGITS = 6;
 147 var
 148   digitcount: integer;
 149 begin
 150   digitcount := 0;
 151   While ParseDigit do begin
 152     inc(digitcount);
 153   end;
 154   result := (digitcount > 0);
 155   if digitcount > MAX_INT_DIGITS then
 156     RaiseInvalidFormatSpecifier;
 157 end;
 158
 159 procedure TFormatStrParser.ForceParseType;
 160 begin
 161   if PFormatString^ = #0 then
 162     RaiseInvalidFormatSpecifier;
 163
 164   case PFormatString^ of
 165     'd', 'u', 'x', 'e', 'f', 'g', 'n', 'm', 'p', 's',
 166     'D', 'U', 'X', 'E', 'F', 'G', 'N', 'M', 'P', 'S':
 167   begin
 168     // do nothing
 169   end
 170   else
 171     RaiseInvalidFormatSpecifier;
 172   end;
 173   ForceParseChar(PFormatString^);
 174 end;
 175
 176 function TFormatStrParser.PeekIndexSpecifier(out Index: Integer): Boolean;
 177 var
 178   SaveParsedString: WideString;
 179   SaveFormatString: PWideChar;
 180 begin
 181   SaveParsedString := ParsedString.Value;
 182   SaveFormatString := PFormatString;
 183   try
 184     ParsedString.Clear;
 185     Result := False;
 186     Index := -1;
 187     if ParseInteger then begin
 188       Index := StrToInt(ParsedString.Value);
 189       if ParseChar(':') then
 190         Result := True;
 191     end;
 192   finally
 193     ParsedString.Clear;
 194     ParsedString.AddString(SaveParsedString);
 195     PFormatString := SaveFormatString;
 196   end;
 197 end;
 198
 199 function TFormatStrParser.ParseFormatSpecifier: Boolean;
 200 var
 201   ExplicitIndex: Integer;
 202 begin
 203   Result := False;
 204   // Parse entire format specifier
 205   ForceParseChar('%');
 206   if (PFormatString^ <> #0)
 207   and (not ParseChar(' '))
 208   and (not ParseChar('%')) then begin
 209     if PeekIndexSpecifier(ExplicitIndex) then begin
 210       Inc(ExplicitCount);
 211       LastIndex := Max(LastIndex, ExplicitIndex);
 212     end else begin
 213       Inc(ImplicitCount);
 214       Inc(LastIndex);
 215       ParsedString.AddString(IntToStr(LastIndex));
 216       ParsedString.AddChar(':');
 217     end;
 218     if ParseChar('*') then
 219     begin
 220       Inc(ImplicitCount);
 221       Inc(LastIndex);
 222       ParseChar(':');
 223     end else if ParseInteger then
 224       ParseChar(':');
 225     ParseChar('-');
 226     if ParseChar('*') then begin
 227       Inc(ImplicitCount);
 228       Inc(LastIndex);
 229     end else
 230       ParseInteger;
 231     if ParseChar('.') then begin
 232       if not ParseChar('*') then
 233         ParseInteger;
 234     end;
 235     ForceParseType;
 236     Result := True;
 237   end;
 238 end;
 239
 240 //-----------------------------------
 241
 242 function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
 243 var
 244   PosSpec: Integer;
 245 begin
 246   with TFormatStrParser.Create(_FormatString) do
 247   try
 248     // loop until no more '%'
 249     PosSpec := Pos('%', PFormatString);
 250     While PosSpec <> 0 do begin
 251       try
 252         // delete everything up until '%'
 253         ParsedString.AddBuffer(PFormatString, PosSpec - 1);
 254         Inc(PFormatString, PosSpec - 1);
 255         // parse format specifier
 256         ParseFormatSpecifier;
 257       finally
 258         PosSpec := Pos('%', PFormatString);
 259       end;
 260     end;
 261     if ((ExplicitCount = 0) and (ImplicitCount = 1)) {simple expression}
 262     or ((ExplicitCount > 0) and (ImplicitCount = 0)) {nothing converted} then
 263       result := _FormatString {original}
 264     else
 265       result := ParsedString.Value + PFormatString;
 266   finally
 267     Free;
 268   end;
 269 end;
 270
 271 {$IFNDEF COMPILER_9_UP}
 272 function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
 273   const Args: array of const
 274     {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
 275 { This function replaces floating point format specifiers with their actual formatted values.
 276   It also adds index specifiers so that the other format specifiers don't lose their place.
 277   The reason for this is that WideFormat doesn't correctly format floating point specifiers.
 278   See QC#4254. }
 279 var
 280   Parser: TFormatStrParser;
 281   PosSpec: Integer;
 282   Output: TBufferedWideString;
 283 begin
 284   Output := TBufferedWideString.Create;
 285   try
 286     Parser := TFormatStrParser.Create(_FormatString);
 287     with Parser do
 288     try
 289       // loop until no more '%'
 290       PosSpec := Pos('%', PFormatString);
 291       While PosSpec <> 0 do begin
 292         try
 293           // delete everything up until '%'
 294           Output.AddBuffer(PFormatString, PosSpec - 1);
 295           Inc(PFormatString, PosSpec - 1);
 296           // parse format specifier
 297           ParsedString.Clear;
 298           if (not ParseFormatSpecifier)
 299           or (GetFormatSpecifierType(ParsedString.Value) <> fstFloating) then
 300             Output.AddBuffer(ParsedString.BuffPtr, MaxInt)
 301           {$IFDEF COMPILER_7_UP}
 302           else if Assigned(FormatSettings) then
 303             Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args, FormatSettings^))
 304           {$ENDIF}
 305           else
 306             Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args));
 307         finally
 308           PosSpec := Pos('%', PFormatString);
 309         end;
 310       end;
 311       Output.AddString(PFormatString);
 312     finally
 313       Free;
 314     end;
 315     Result := Output.Value;
 316   finally
 317     Output.Free;
 318   end;
 319 end;
 320 {$ENDIF}
 321
 322 procedure GetFormatArgs(const _FormatString: WideString; FormatArgs: TTntStrings);
 323 var
 324   PosSpec: Integer;
 325 begin
 326   with TFormatStrParser.Create(_FormatString) do
 327   try
 328     FormatArgs.Clear;
 329     // loop until no more '%'
 330     PosSpec := Pos('%', PFormatString);
 331     While PosSpec <> 0 do begin
 332       try
 333         // delete everything up until '%'
 334         Inc(PFormatString, PosSpec - 1);
 335         // add format specifier to list
 336         ParsedString.Clear;
 337         if ParseFormatSpecifier then
 338           FormatArgs.Add(ParsedString.Value);
 339       finally
 340         PosSpec := Pos('%', PFormatString);
 341       end;
 342     end;
 343   finally
 344     Free;
 345   end;
 346 end;
 347
 348 function GetExplicitIndex(const FormatSpecifier: WideString): Integer;
 349 var
 350   IndexStr: WideString;
 351   PosColon: Integer;
 352 begin
 353   result := -1;
 354   PosColon := Pos(':', FormatSpecifier);
 355   if PosColon <> 0 then begin
 356     IndexStr := Copy(FormatSpecifier, 2, PosColon - 2);
 357     result := StrToInt(IndexStr);
 358   end;
 359 end;
 360
 361 function GetMaxIndex(FormatArgs: TTntStrings): Integer;
 362 var
 363   i: integer;
 364   RunningIndex: Integer;
 365   ExplicitIndex: Integer;
 366 begin
 367   result := -1;
 368   RunningIndex := -1;
 369   for i := 0 to FormatArgs.Count - 1 do begin
 370     ExplicitIndex := GetExplicitIndex(FormatArgs[i]);
 371     if ExplicitIndex <> -1 then
 372       RunningIndex := ExplicitIndex
 373     else
 374       inc(RunningIndex);
 375     result := Max(result, RunningIndex);
 376   end;
 377 end;
 378
 379 procedure UpdateTypeList(FormatArgs, TypeList: TTntStrings);
 380 var
 381   i: integer;
 382   f: WideString;
 383   SpecType: TFormatSpecifierType;
 384   ExplicitIndex: Integer;
 385   MaxIndex: Integer;
 386   RunningIndex: Integer;
 387 begin
 388   // set count of TypeList to accomodate maximum index
 389   MaxIndex := GetMaxIndex(FormatArgs);
 390   TypeList.Clear;
 391   for i := 0 to MaxIndex do
 392     TypeList.Add('');
 393
 394   // for each arg...
 395   RunningIndex := -1;
 396   for i := 0 to FormatArgs.Count - 1 do begin
 397     f := FormatArgs[i];
 398     ExplicitIndex := GetExplicitIndex(f);
 399     SpecType := GetFormatSpecifierType(f);
 400
 401     // determine running arg index
 402     if ExplicitIndex <> -1 then
 403       RunningIndex := ExplicitIndex
 404     else
 405       inc(RunningIndex);
 406
 407     if TypeList[RunningIndex] <> '' then begin
 408       // already exists in list, check for compatibility
 409       if TypeList.Objects[RunningIndex] <> TObject(SpecType) then
 410         raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
 411           [RunningIndex, TypeList[RunningIndex], f]);
 412     end else begin
 413       // not in list so update it
 414       TypeList[RunningIndex] := f;
 415       TypeList.Objects[RunningIndex] := TObject(SpecType);
 416     end;
 417   end;
 418 end;
 419
 420 procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
 421 var
 422   ArgList1: TTntStringList;
 423   ArgList2: TTntStringList;
 424   TypeList1: TTntStringList;
 425   TypeList2: TTntStringList;
 426   i: integer;
 427 begin
 428   ArgList1 := nil;
 429   ArgList2 := nil;
 430   TypeList1 := nil;
 431   TypeList2 := nil;
 432   try
 433     ArgList1 := TTntStringList.Create;
 434     ArgList2 := TTntStringList.Create;
 435     TypeList1 := TTntStringList.Create;
 436     TypeList2 := TTntStringList.Create;
 437
 438     GetFormatArgs(FormatStr1, ArgList1);
 439     UpdateTypeList(ArgList1, TypeList1);
 440
 441     GetFormatArgs(FormatStr2, ArgList2);
 442     UpdateTypeList(ArgList2, TypeList2);
 443
 444     if TypeList1.Count <> TypeList2.Count then
 445       raise EFormatSpecError.Create(SMismatchedArgumentCounts + CRLF + CRLF + '> ' + FormatStr1 + CRLF + '> ' + FormatStr2);
 446
 447     for i := 0 to TypeList1.Count - 1 do begin
 448       if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
 449         raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
 450           [i, TypeList1[i], TypeList2[i]]);
 451       end;
 452     end;
 453
 454   finally
 455     ArgList1.Free;
 456     ArgList2.Free;
 457     TypeList1.Free;
 458     TypeList2.Free;
 459   end;
 460 end;
 461
 462 function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
 463 var
 464   ArgList1: TTntStringList;
 465   ArgList2: TTntStringList;
 466   TypeList1: TTntStringList;
 467   TypeList2: TTntStringList;
 468   i: integer;
 469 begin
 470   ArgList1 := nil;
 471   ArgList2 := nil;
 472   TypeList1 := nil;
 473   TypeList2 := nil;
 474   try
 475     ArgList1 := TTntStringList.Create;
 476     ArgList2 := TTntStringList.Create;
 477     TypeList1 := TTntStringList.Create;
 478     TypeList2 := TTntStringList.Create;
 479
 480     GetFormatArgs(FormatStr1, ArgList1);
 481     UpdateTypeList(ArgList1, TypeList1);
 482
 483     GetFormatArgs(FormatStr2, ArgList2);
 484     UpdateTypeList(ArgList2, TypeList2);
 485
 486     Result := (TypeList1.Count = TypeList2.Count);
 487     if Result then begin
 488       for i := 0 to TypeList1.Count - 1 do begin
 489         if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
 490           Result := False;
 491           break;
 492         end;
 493       end;
 494     end;
 495   finally
 496     ArgList1.Free;
 497     ArgList2.Free;
 498     TypeList1.Free;
 499     TypeList2.Free;
 500   end;
 501 end;
 502
 503 end.