sakurasuite/SsParser.pas

   1 {********************************************************}
   2 { TSsParser Component - Parser for Sakura Script         }
   3 {                                                        }
   4 {       Copyright (c) 2001-2003 naruto/CANO-Lab          }
   5 {                 (c) 2001-2005 WinBottle Project        }
   6 {********************************************************}
   7
   8 unit SsParser;
   9
  10 interface
  11
  12 uses
  13   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  14   Contnrs;
  15
  16 type
  17   // Kind of the Markup
  18   // mtTag:  Tag. (begins with \)
  19   // mtMeta: Meta expression. (begins with %)
  20   // mtTagErr: Seems to be a markup error
  21   // mtStr: Other normal talk string
  22   TSsMarkUpType = (mtTag, mtMeta, mtTagErr, mtStr);
  23
  24   // Intercepting the parsing
  25   TSsParseEvent = procedure (Sender: TObject; const Script: string;
  26     var Len: integer; var MarkType: TSsMarkUpType; var Extra: string) of object;
  27
  28   // Exception class
  29   ESsParserError = class(Exception);
  30
  31   // Internally used private class
  32   // Do not use this class outside this unit!
  33   TSsMarkUp = class(TPersistent)
  34   private
  35     FPos: Integer;
  36     FExtra: string;
  37     FMarkUpType: TSsMarkUpType;
  38     FStr: string;
  39   public
  40     procedure Assign(Source: TPersistent); override;
  41     constructor Create(Pos: Integer; MarkUpType: TSsMarkUpType; Str: string;
  42       Extra: string = '');
  43   published
  44     property Pos: Integer read FPos; //This markup is Pos'th character in InputString
  45     property MarkUpType: TSsMarkUpType read FMarkUpType;
  46     property Str: string read FStr;
  47     property Extra: string read FExtra write FExtra;
  48   end;
  49
  50    // TSsParseResult class
  51   TSsParseResult = class(TObject)
  52   private
  53     FInputString: string;
  54     FList: TObjectList;
  55     function GetCount: Integer;
  56     function GetExtra(Index: Integer): string;
  57     function GetMarkUpType(Index: Integer): TSsMarkUpType;
  58     function GetPosition(Index: Integer): Integer;
  59     function GetStr(Index: Integer): string;
  60     procedure SetExtra(Index: Integer; const Value: string);
  61     function GetItem(Index: Integer): TSsMarkUp;
  62     procedure Clear;
  63     procedure Add(Pos: Integer; MarkUpType: TSsMarkUpType; Str: string;
  64       Extra: string = '');
  65   protected
  66     property Item[Index: Integer]: TSsMarkUp read GetItem;
  67   public
  68     constructor Create(const InputString: string);
  69     destructor Destroy; override;
  70     function MarkUpAt(const Pos: Integer): Integer;
  71     property Count: Integer read GetCount;
  72     property MarkUpType[Index: Integer]: TSsMarkUpType read GetMarkUpType;
  73     property Str[Index: Integer]: string read GetStr; default;
  74     property Extra[Index: Integer]: string read GetExtra write SetExtra;
  75     property Position[Index: Integer]: Integer read GetPosition;
  76     property InputString: string read FInputString; // Cannot Write
  77   end;
  78
  79   // Notes to user:
  80   // This class has been modified so that it can handle multiple parsing
  81   // results, but this class is NOT thread-safe.
  82   // If you want to parse scripts within more than one thread,
  83   // separate parser instance should be prepared for each thread.
  84   TSsParser = class(TComponent)
  85   private
  86     FTagPattern: TStrings;  //SakuraScript tag pattern string
  87     FMetaPattern: TStrings; //SakuraScript meta expression pattern string
  88     FBuffList: TSsParseResult; //To implement deprecated properties
  89     FLeaveEscape: boolean;
  90     FEscapeInvalidMeta: boolean;
  91     FOnParse: TSsParseEvent;
  92     FPatternStudied: Boolean; // Whether pattern definition is optimized
  93     FTagPatternTable: TStrings;
  94     FTagPatternPointer: array[Char] of Integer;
  95     FMetaPatternTable: TStrings;
  96     FMetaPatternPointer: array[Char] of Integer;
  97     procedure SetInputString(const Value: string);
  98     function GetCount: integer;
  99     function GetExtra(Index: integer): string;
 100     function GetMarkUpType(Index: integer): TSsMarkUpType;
 101     function GetStr(Index: integer): string;
 102     procedure SetExtra(Index: integer; const Value: string);
 103     procedure SetMetaPattern(const Value: TStrings);
 104     procedure SetTagPattern(const Value: TStrings);
 105     procedure SetOnParse(const Value: TSsParseEvent);
 106     function GetFirstChar(const Str: string): string;
 107     function GetPosition(Index: integer): integer;
 108     function GetInputString: string;
 109   protected
 110     function ChopFirstChar(var Str: string): string;
 111     procedure BeginParse(ResultList: TSsParseResult);
 112     procedure Study;
 113   public
 114     constructor Create(AOwner: TComponent); override;
 115     destructor Destroy; override;
 116     function MatchP(PStr, PPattern: PChar): integer;
 117     function Match(Str, Pattern: string): integer;
 118     function GetParam(Tag: string; const Index: integer): string;
 119     function EscapeParam(const Param: string): string;
 120     function MarkUpAt(const Pos: integer): integer;
 121
 122     function Parse(const Script: string): TSsParseResult;
 123
 124     { These properties are deprecated. }
 125     property Count: integer read GetCount;
 126     property MarkUpType[Index: integer]: TSsMarkUpType read GetMarkUpType;
 127     property Str[Index: integer]: string read GetStr; default;
 128     property Extra[Index: integer]: string read GetExtra write SetExtra;
 129     property Position[Index: integer]: integer read GetPosition;
 130
 131     property InputString: string read GetInputString write SetInputString;
 132   published
 133     // Script parsing patterns.
 134     property TagPattern: TStrings read FTagPattern write SetTagPattern;
 135     property MetaPattern: TStrings read FMetaPattern write SetMetaPattern;
 136     // Whether to leave escape sequence "\\" and "\%" in mtStr elements
 137     property LeaveEscape: boolean read FLeaveEscape write FLeaveEscape
 138       default true;
 139     // Replace '%' to '\%' if sequence follwing the '%' could not
 140     // be parsed as a meta expression
 141     property EscapeInvalidMeta: boolean read FEscapeInvalidMeta
 142       write FEscapeInvalidMeta default false;
 143     // Component users can intercept and handle part of the parsing using this event.
 144     property OnParse: TSsParseEvent read FOnParse write SetOnParse;
 145   end;
 146
 147 procedure Register;
 148
 149 implementation
 150
 151 resourcestring
 152   CElementTypeError = '\90³\82µ\82¢\83G\83\8c\83\81\83\93\83g\83^\83C\83v\82ð\95Ô\82µ\82Ä\82\82¾\82³\82¢';
 153   CTagPatternSyntaxError = 'TagPattern\95\\8bL\83~\83X %d \8ds\96Ú';
 154   CMarkupIndexOutofRange = '\83C\83\93\83f\83b\83N\83X\82ª\94Í\88Í\82ð\82±\82¦\82Ä\82¢\82Ü\82·';
 155
 156 {
 157   // English error message
 158   CElementTypeError = 'Returned element type is invalid in OnParse.';
 159   CTagPatternSyntaxError = 'TagPattern syntax error at line %d.';
 160   CMarkupIndexOutofRange = 'Markup index if out of range.';
 161 }
 162
 163
 164 procedure Register;
 165 begin
 166   RegisterComponents('Samples', [TSsParser]);
 167 end;
 168
 169 { TSsParser }
 170
 171 procedure TSsParser.BeginParse(ResultList: TSsParseResult);
 172 var Str, Talk, T, Ex: string;
 173     i, Le: integer;
 174     IsErr: boolean;
 175     Mt: TSsMarkUpType;
 176     PHead, PStr, PTalk, PTail, Buf: PChar;
 177 begin
 178   // Pattern study must be done the first time you parse.
 179   if not FPatternStudied then
 180     Study;
 181   ResultList.Clear;
 182   Str := ResultList.InputString; // The string to be parsed from now
 183   // This is to avoid access violation if `Str` is terminated
 184   // with DBCS leadbyte. (Such string is invalid from the beginning of course)
 185   Str := Str + #0#0;
 186   if Length(Str) = 0 then
 187     Exit;
 188   PHead := PChar(Str); // const
 189   PTail := PChar(Str);
 190   PStr := PChar(Str);
 191   // Length(Talk) <= Length(Str) * 2
 192   // Because a script like '%%%' is converted to '\%\%\%' if EscapeInvalidMeta is on
 193   SetLength(Talk, Length(Str) * 2 + 2);
 194   PTalk := PChar(Talk);
 195   while PStr^ <> #0 do begin
 196     if PStr^ = '\' then begin
 197       Inc(PStr);
 198       if PStr^ = '\' then
 199       begin
 200         // Escaped sequence "\\"
 201         if FLeaveEscape then
 202         begin
 203           PTalk^ := '\';
 204           Inc(PTalk);
 205           PTalk^ := '\';
 206           Inc(PTalk);
 207         end else
 208         begin
 209           PTalk^ := '\';
 210           Inc(PTalk);
 211         end;
 212         Inc(PStr);
 213         Continue;
 214       end else if PStr^ = '%' then
 215       begin
 216         // Escaped sequence "\%"
 217         if FLeaveEscape then
 218         begin
 219           PTalk^ := '\';
 220           Inc(PTalk);
 221           PTalk^ := '%';
 222           Inc(PTalk);
 223         end else
 224         begin
 225           PTalk^ := '%';
 226           Inc(PTalk);
 227         end;
 228         Inc(PStr);
 229         Continue;
 230       end else
 231       begin
 232         Dec(PStr);
 233         // might be a tag
 234         // Generate OnParser event
 235         Le := 0;
 236         Ex := '';
 237         IsErr := false;
 238         if Assigned(FOnParse) then begin
 239           FOnParse(Self, string(PStr), Le, Mt, Ex);
 240           if Le > 0 then begin
 241             if (Mt <> mtTag) and (Mt <> mtTagErr) then begin
 242               raise ESsParserError.Create(CElementTypeError);
 243               Exit;
 244             end;
 245             if Mt = mtTagErr then IsErr := true;
 246           end;
 247         end;
 248         if Le <= 0 then
 249         begin
 250           Inc(PStr);
 251           i := FTagPatternPointer[PStr^];
 252           if i > -1 then
 253             while (i < FTagPatternTable.Count) do begin
 254               T := FTagPatternTable[i];
 255               IsErr := T[1] = '!';
 256               Buf := PChar(T);
 257               Inc(Buf);
 258               Le := MatchP(PStr, Buf);
 259               if Le > 0 then
 260               begin
 261                 Inc(Le);
 262                 Dec(PStr);
 263                 Break;
 264               end;
 265               if T[2] <> PStr^ then
 266                 Break;
 267               Inc(i);
 268             end;
 269         end;
 270         if PChar(Talk) <> PTalk then begin
 271           PTalk^ := #0;
 272           ResultList.Add(PTail-PHead+1, mtStr, string(PChar(Talk)));
 273           PTalk := PChar(Talk);
 274         end;
 275         if Le > 0 then begin
 276           // Parsed as a correct tag
 277           T := Copy(string(PStr), 1, Le);
 278           if IsErr then
 279             ResultList.Add(PStr-PHead+1, mtTagErr, T, Ex)
 280           else
 281             ResultList.Add(PStr-PHead+1, mtTag, T, Ex);
 282           Inc(PStr, Le);
 283         end else begin
 284           // Parsing failed; The character '\' and the next one character is
 285           // marked as a tag error.
 286           Inc(PStr); // Skip '\'
 287           if PStr^ in LeadBytes then
 288           begin
 289             T := '\' + Copy(string(PStr), 1, 2);
 290             ResultList.Add(PStr-PChar(Str), mtTagErr, T);
 291             Inc(PStr, 2);
 292           end else
 293           begin
 294             T := '\' + PStr^;
 295             ResultList.Add(PStr-PChar(Str), mtTagErr, T);
 296             Inc(PStr);
 297           end;
 298         end;
 299         PTail := PStr;
 300       end;
 301     end else if (PStr^ = '%') then begin
 302       Le := 0; Ex := '';
 303       if Assigned(FOnParse) then begin
 304         FOnParse(Self, string(PStr), Le, Mt, Ex);
 305         if Le > 0 then begin
 306           if Mt <> mtMeta then begin
 307             raise ESsParserError.Create(CElementTypeError);
 308             Exit;
 309           end;
 310           Dec(Le);
 311         end;
 312       end;
 313       Inc(PStr); // Skip '%'
 314       if Le <= 0 then
 315       begin
 316         i := FMetaPatternPointer[PStr^];
 317         if i > -1 then
 318           while i < FMetaPatternTable.Count do
 319           begin
 320             Le := MatchP(PStr, PChar(FMetaPatternTable[i]));
 321             if Le > 0 then
 322               Break;
 323             if FMetaPatternTable[i][1] <> PStr^ then
 324               Break;
 325             Inc(i);
 326           end;
 327       end;
 328       if Le > 0 then // Matched as valid meta string
 329       begin
 330         if PChar(Talk) <> PTalk then
 331         begin
 332           PTalk^ := #0;
 333           ResultList.Add(PTail-PHead+1, mtStr, string(PChar(Talk)));
 334           PTalk := PChar(Talk);
 335         end;
 336         T := Copy(string(PStr), 1, Le);
 337         ResultList.Add(PStr-PChar(Str), mtMeta, '%' + T, Ex);
 338         Inc(PStr, Le);
 339         PTail := PStr;
 340       end else
 341       begin
 342         // in case this %??? sequence seems NOT to be a meta expression
 343         if FEscapeInvalidMeta then
 344         begin
 345           PTalk^ := '\';
 346           Inc(PTalk);
 347           PTalk^ := '%';
 348           Inc(PTalk);
 349         end else
 350         begin
 351           PTalk^ := '%';
 352           Inc(PTalk);
 353         end;
 354         Continue;
 355       end;
 356     end else begin
 357       if PStr^ in LeadBytes then
 358       begin
 359         PTalk^ := PStr^;
 360         Inc(PStr); Inc(PTalk);
 361         PTalk^ := PStr^;
 362         Inc(PStr); Inc(PTalk);
 363       end else
 364       begin
 365         PTalk^ := PStr^;
 366         Inc(PStr); Inc(PTalk);
 367       end;
 368     end;
 369   end; // of while
 370   if PTalk <> PChar(Talk) then
 371   begin
 372     PTalk^ := #0;
 373     ResultList.Add(PTail-PHead+1, mtStr, string(PChar(Talk)));
 374   end;
 375 end;
 376
 377 function TSsParser.ChopFirstChar(var Str: string): string;
 378 begin
 379   Result := GetFirstChar(Str);
 380   Delete(Str, 1, Length(Result));
 381 end;
 382
 383 constructor TSsParser.Create(AOwner: TComponent);
 384 begin
 385   inherited;
 386   FTagPattern  := TStringList.Create;
 387   FMetaPattern := TStringList.Create;
 388   FTagPatternTable  := TStringList.Create;
 389   FMetaPatternTable := TStringList.Create;
 390   FLeaveEscape := true;
 391 end;
 392
 393 destructor TSsParser.Destroy;
 394 begin
 395   inherited;
 396   FTagPattern.Free;
 397   FMetaPattern.Free;
 398   FTagPatternTable.Free;
 399   FMetaPatternTable.Free;
 400   if FBuffList <> nil then
 401     FBuffList.Free;
 402 end;
 403
 404 function TSsParser.EscapeParam(const Param: string): string;
 405 begin
 406   //StringReplace supports DBCS
 407   Result := StringReplace(Param, '\', '\\', [rfReplaceAll]);
 408   Result := StringReplace(Param, ']', '\]', [rfReplaceAll]);
 409 end;
 410
 411 function TSsParser.GetCount: integer;
 412 begin
 413   if FBuffList <> nil then
 414     Result := FBuffList.Count
 415   else
 416     Result := 0;
 417 end;
 418
 419 function TSsParser.GetExtra(Index: integer): string;
 420 begin
 421   if (Index >= 0) and (Index < FBuffList.Count) then
 422     Result := FBuffList.Extra[Index]
 423   else
 424     Result := '';
 425 end;
 426
 427 function TSsParser.GetFirstChar(const Str: string): string;
 428 begin
 429   // Get the first character of the given string. Supports DBCS
 430   if Length(Str) <= 1 then begin
 431     Result := Str;
 432   end else begin
 433     if Str[1] in LeadBytes then begin
 434       Result := Str[1] + Str[2];
 435     end else begin
 436       Result := Str[1];
 437     end;
 438   end;
 439 end;
 440
 441 function TSsParser.GetInputString: string;
 442 begin
 443   if FBuffList <> nil then
 444     Result := FBuffList.InputString
 445   else
 446     Result := '';
 447 end;
 448
 449 function TSsParser.GetMarkUpType(Index: integer): TSsMarkUpType;
 450 begin
 451   if (Index >= 0) and (Index <= FBuffList.Count-1) then
 452     Result := FBuffList.MarkUpType[Index]
 453   else
 454     raise ESsParserError.Create(CMarkupIndexOutOfRange);
 455 end;
 456
 457 function TSsParser.GetParam(Tag: string;
 458   const Index: integer): string;
 459 var ParamCount: integer;
 460     First, Param: string;
 461     Escape, Inside: boolean;
 462 begin
 463   if Index <= 0 then Exit;
 464   Inside := false;
 465   ParamCount := 0;
 466   Escape := false;
 467   repeat
 468     First := ChopFirstChar(Tag);
 469     if Inside then begin
 470       if Escape then begin
 471         if First = '\' then Param := Param + '\'
 472         else if First = ']' then Param := Param + ']'
 473         else Param := Param + '\' + First;
 474         Escape := false;
 475       end else if First = '\' then
 476         Escape := true
 477       else if First = ']' then
 478         Inside := false
 479       else begin
 480         Escape := false;
 481         Param := Param + First;
 482       end;
 483     end else if First = '[' then begin
 484       Inside := true;
 485       Escape := false;
 486       Param := '';
 487       Inc(ParamCount);
 488     end;
 489   until (First = '') or ((ParamCount = Index) and not Inside);
 490   if ((ParamCount = Index) and not Inside) then
 491     Result := Param
 492   else
 493     Result := '';
 494 end;
 495
 496 function TSsParser.GetPosition(Index: integer): integer;
 497 begin
 498   if (Index >= 0) and (Index < FBuffList.Count) then
 499     Result := FBuffList.Position[Index]
 500   else
 501     Result := 0;
 502 end;
 503
 504 function TSsParser.GetStr(Index: integer): string;
 505 begin
 506   if (Index >= 0) and (Index < FBuffList.Count) then
 507     Result := FBUffList[Index]
 508   else
 509     Result := '';
 510 end;
 511
 512 function TSsParser.MarkUpAt(const Pos: integer): Integer;
 513 begin
 514   Result := FBuffList.MarkUpAt(Pos);
 515 end;
 516
 517 function TSsParser.Match(Str, Pattern: string): integer;
 518 begin
 519   if (Length(Str) = 0) or (Length(Pattern) = 0) then
 520     Result := 0
 521   else
 522     Result := MatchP(@Str[1], @Pattern[1]);
 523 end;
 524
 525 function TSsParser.MatchP(PStr, PPattern: PChar): integer;
 526 var Matched, F, Escape: boolean;
 527 begin
 528   Matched := true;
 529   Result := 0;
 530   while Matched and (PPattern^ <> #0) do begin
 531     if PPattern^ = '%' then
 532     begin
 533       if PStr^ = #0 then
 534       begin
 535         Matched := false;
 536         Break;
 537       end;
 538       Inc(PPattern);
 539       case PPattern^ of
 540         '%':
 541           begin
 542             if PStr^ = '%' then
 543             begin
 544               Inc(Result);
 545               Inc(PStr);
 546               Inc(PPattern);
 547             end else
 548             begin
 549               Matched := false;
 550               Break;
 551             end;
 552           end;
 553         'd':
 554           begin
 555             if PStr^ in ['0' .. '9'] then
 556             begin
 557               Inc(Result);
 558               Inc(PStr);
 559               Inc(PPattern);
 560             end else
 561               Matched := false;
 562           end;
 563         'D':
 564           begin
 565             if PStr^ in ['0' .. '9'] then
 566             begin
 567               while PStr^ in ['0' .. '9'] do
 568               begin
 569                 Inc(Result);
 570                 Inc(PStr);
 571               end;
 572               Inc(PPattern);
 573             end else
 574               Matched := false;
 575           end;
 576         'b': //String enclosed by '[' and ']'. The content may be an empty string.
 577           begin
 578             if PStr^ <> '[' then
 579             begin
 580               Matched := false;
 581             end else
 582             begin
 583               F := false;
 584               Escape := false; //After escape character
 585               Inc(PStr);   // '['
 586               Inc(Result); // '['
 587               repeat
 588                 if Escape then
 589                 begin
 590                   Escape := false;
 591                 end else
 592                 begin
 593                   if PStr^ = '\' then Escape := true;
 594                   if PStr^ = ']' then F := true;
 595                 end;
 596                 if PStr^ in LeadBytes then
 597                 begin
 598                   Inc(Result, 2);
 599                   Inc(PStr, 2);
 600                 end else
 601                 begin
 602                   Inc(Result);
 603                   Inc(PStr);
 604                 end;
 605               until (PStr^ = #0) or F;
 606               if not F then
 607                 Matched := false;
 608             end;
 609             Inc(PPattern);
 610           end;
 611         'c': // String which can be the argument content enclosed by '[' and ']'
 612           begin
 613             Inc(PPattern);
 614             if not (PStr^ = ']') then
 615             begin
 616               Escape := false;
 617               repeat
 618                 if Escape then
 619                   Escape := false
 620                 else if PStr^ = ']' then
 621                   Break
 622                 else
 623                   if PStr^ = '\' then Escape := true;
 624                 if PStr^ in LeadBytes then
 625                 begin
 626                   Inc(Result, 2);
 627                   Inc(PStr, 2);
 628                 end else
 629                 begin
 630                   Inc(Result);
 631                   Inc(PStr);
 632                 end;
 633               until (PStr^ = #0);
 634             end else
 635               Matched := false;
 636           end;
 637         'm':
 638           begin
 639             if not (PStr^ in LeadBytes) then
 640             begin
 641               Inc(PPattern);
 642               Inc(PStr);
 643               Inc(Result);
 644             end else Matched := false;
 645           end;
 646         'M':
 647           begin
 648             if (PStr^ in LeadBytes) then
 649             begin
 650               Inc(PPattern);
 651               Inc(PStr, 2);
 652               Inc(Result, 2);
 653             end else Matched := false;
 654           end;
 655         '.':
 656           if (PStr^ in LeadBytes) then
 657           begin
 658             Inc(PPattern);
 659             Inc(PStr, 2);
 660             Inc(Result, 2);
 661           end else
 662           begin
 663             Inc(PPattern);
 664             Inc(PStr);
 665             Inc(Result);
 666           end;
 667         else
 668           if PStr^ = '%' then
 669           begin
 670             Inc(PStr);
 671             Inc(Result);
 672           end else
 673           begin
 674             Matched := false;
 675           end;
 676       end // of case
 677     end else
 678     begin
 679       if PStr^ <> PPattern^ then
 680         Matched := false
 681       else
 682       begin
 683         Inc(Result);
 684         Inc(PStr);
 685         Inc(PPattern);
 686       end;
 687     end;
 688   end; //of while
 689   if not Matched then Result := 0;
 690 end;
 691
 692 function TSsParser.Parse(const Script: string): TSsParseResult;
 693 begin
 694   Result := TSsParseResult.Create(Script);
 695   BeginParse(Result);
 696 end;
 697
 698 procedure TSsParser.SetExtra(Index: integer; const Value: string);
 699 begin
 700   FBuffList.Extra[Index] := Value;
 701 end;
 702
 703 procedure TSsParser.SetInputString(const Value: string);
 704 begin
 705   // Warning! This property is deprecated
 706   // Use Parse() method instead.
 707   if FBuffList <> nil then
 708   begin
 709     FBuffList.FInputString := Value; // Access to private method outside the class!
 710     FBuffList.Clear
 711   end else
 712     FBuffList := TSsParseResult.Create(Value);
 713   BeginParse(FBuffList);
 714 end;
 715
 716 procedure TSsParser.SetMetaPattern(const Value: TStrings);
 717 begin
 718   FMetaPattern.Assign(Value);
 719   FPatternStudied := false;
 720 end;
 721
 722 procedure TSsParser.SetOnParse(const Value: TSsParseEvent);
 723 begin
 724   FOnParse := Value;
 725 end;
 726
 727 procedure TSsParser.SetTagPattern(const Value: TStrings);
 728 begin
 729   FTagPattern.Assign(Value);
 730   FPatternStudied := false;
 731 end;
 732
 733 procedure TSsParser.Study;
 734 var
 735   i, index, count: Integer;
 736   c: Char;
 737 begin
 738   // Pattern studying is done for reducing meaningless pattern matching.
 739   FTagPatternTable.Clear;
 740   for c := Low(Char) to High(Char) do
 741   begin
 742     count := 0;
 743     FTagPatternPointer[c] := -1;
 744     for i := 0 to FTagPattern.Count-1 do
 745     begin
 746       if Length(FTagPattern[i]) < 2 then
 747         Continue; // invalid pattern
 748       if not (FTagPattern[i][1] in ['\', '!']) then
 749         raise ESsParserError.CreateFmt(CTagPatternSyntaxError, [i+1]);
 750       if FTagPattern[i][2] = c then
 751       begin
 752         Inc(count);
 753         index := FTagPatternTable.Add(FTagPattern[i]);
 754         if count = 1 then
 755           FTagPatternPointer[c] := index;
 756       end;
 757     end;
 758   end;
 759   FMetaPatternTable.Clear;
 760   for c := Low(Char) to High(Char) do
 761   begin
 762     count := 0;
 763     FMetaPatternPointer[c] := -1;
 764     for i := 0 to FMetaPattern.Count-1 do
 765     begin
 766       if Length(FMetaPattern[i]) < 1 then
 767         Continue; // invalid pattern
 768       if FMetaPattern[i][1] = c then
 769       begin
 770         Inc(count);
 771         index := FMetaPatternTable.Add(FMetaPattern[i]);
 772         if count = 1 then
 773           FMetaPatternPointer[c] := index;
 774       end;
 775     end;
 776   end;
 777   FPatternStudied := true;
 778 end;
 779
 780 { TSsMarkUp }
 781
 782 procedure TSsMarkUp.Assign(Source: TPersistent);
 783 var
 784   Src: TSsMarkUp;
 785 begin
 786   if Source is TSsMarkUp then
 787   begin
 788     Src := Source as TSsMarkUp;
 789     FPos := Src.FPos;
 790     FMarkUpType := Src.FMarkUpType;
 791     FStr := Src.FStr;
 792     FExtra := Src.FExtra;
 793   end else
 794     inherited;
 795 end;
 796
 797 constructor TSsMarkUp.Create(Pos: Integer;
 798   MarkUpType: TSsMarkUpType; Str: string; Extra: string = '');
 799 begin
 800   FPos := Pos;
 801   FMarkUpType := MarkUpType;
 802   FStr := Str;
 803   FExtra := Extra;
 804 end;
 805
 806 { TSsParseResult }
 807
 808 procedure TSsParseResult.Add(Pos: Integer;
 809   MarkUpType: TSsMarkUpType; Str: string; Extra: string);
 810 begin
 811   FList.Add(TSsMarkUp.Create(Pos, MarkUpType, Str, Extra));
 812 end;
 813
 814 procedure TSsParseResult.Clear;
 815 begin
 816   FList.Clear;
 817 end;
 818
 819 constructor TSsParseResult.Create(const InputString: string);
 820 begin
 821   FList := TObjectList.Create(true);
 822   FInputString := InputString;
 823 end;
 824
 825 destructor TSsParseResult.Destroy;
 826 begin
 827   FList.Free;
 828   inherited;
 829 end;
 830
 831 function TSsParseResult.GetCount: Integer;
 832 begin
 833   Result := FList.Count;
 834 end;
 835
 836 function TSsParseResult.GetExtra(Index: integer): string;
 837 begin
 838   try
 839     Result := Item[Index].Extra;
 840   except
 841     on EListError do
 842     begin
 843       raise ESsParserError.Create(CMarkupIndexOutofRange);
 844     end;
 845   end;
 846 end;
 847
 848 function TSsParseResult.GetItem(Index: Integer): TSsMarkUp;
 849 begin
 850   Result := FList[Index] as TSsMarkUp;
 851 end;
 852
 853 function TSsParseResult.GetMarkUpType(Index: integer): TSsMarkUpType;
 854 begin
 855   try
 856     Result := Item[Index].MarkUpType;
 857   except
 858     on EListError do
 859     begin
 860       raise ESsParserError.Create(CMarkupIndexOutofRange);
 861     end;
 862   end;
 863 end;
 864
 865 function TSsParseResult.GetPosition(Index: integer): integer;
 866 begin
 867   try
 868     Result := Item[Index].Pos;
 869   except
 870     on EListError do
 871     begin
 872       raise ESsParserError.Create(CMarkupIndexOutofRange);
 873     end;
 874   end;
 875 end;
 876
 877 function TSsParseResult.GetStr(Index: integer): string;
 878 begin
 879   try
 880     Result := Item[Index].Str;
 881   except
 882     on EListError do
 883     begin
 884       raise ESsParserError.Create(CMarkupIndexOutofRange);
 885     end;
 886   end;
 887 end;
 888
 889 function TSsParseResult.MarkUpAt(const Pos: integer): integer;
 890 var i, lo, hi: integer;
 891 begin
 892   if FList.Count = 0 then
 893     Result := -1
 894   else begin
 895     lo := 0;
 896     hi := FList.Count-2;
 897     i := (hi-lo) div 2 + lo;
 898     while (hi > lo) do
 899     begin
 900       i := (hi-lo) div 2 + lo;
 901       if (Item[i].Pos >= Pos) and
 902          (Item[i+1].Pos < Pos) then
 903       begin
 904          Result := i;
 905          Exit;
 906       end else if Item[i].Pos > Pos then
 907         hi := i
 908       else
 909         lo := i;
 910     end;
 911     Result := i;
 912   end;
 913 end;
 914
 915 procedure TSsParseResult.SetExtra(Index: Integer; const Value: string);
 916 begin
 917   if (Index >= 0) and (Index < FList.Count) then
 918     Item[Index].Extra := Value
 919   else
 920     raise ESsParserError.Create(CMarkupIndexOutOfRange);
 921 end;
 922
 923 end.