sakurasuite/SsParser.pas

   1 (*********************************************************
   2
   3   TSsParser Component - Parser for Sakura Script
   4   (C)2001 naruto/CANO-Lab  All Rights Reserved.
   5
   6   \95K\82¸\8eg\97p\8fð\8c\8f\82É\82µ\82½\82ª\82Á\82Ä\82¨\8eg\82¢\82\82¾\82³\82¢\81B
   7   \81\9a\82±\82Ì\83R\83\93\83|\81[\83l\83\93\83g\82ð\8eg\97p\82µ\82½\83v\83\8d\83O\83\89\83\80\82ð\8cö\8aJ\82·\82é\8fê\8d\87\82Í\81A
   8 \81@\81@\8dì\8eÒ\82É\88ê\95ñ\82·\82é\95K\97v\82ª\82 \82è\82Ü\82·\81B\8fÚ\82µ\82\82Í\90à\96¾\8f\91\82ð\81B
   9
  10 **********************************************************)
  11
  12 unit SsParser;
  13
  14 interface
  15
  16 uses
  17   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
  18
  19 type
  20   //\83}\81[\83N\83A\83b\83v\82Ì\8eí\97Þ\82ð\8e¦\82µ\82Ü\82·\81B
  21   //mtTag:  \83^\83O\82Å\82·\81B\e, \t, \s[1]\82È\82Ç\81A\\82Å\8en\82Ü\82é\82à\82Ì
  22   //mtMeta: \83\81\83^\95¶\8e\9a\97ñ\81B%\82Å\8en\82Ü\82é\82à\82Ì\81B
  23   //mtTagErr: \83^\83O\82Ì\83}\81[\83N\83A\83b\83v\83G\83\89\81[\82Æ\8ev\82í\82ê\82é\95\94\95ª\81B
  24   //mtStr: \83}\81[\83N\83A\83b\83v\82Å\82Í\82È\82¢\95¶\8e\9a\97ñ\81B
  25   TSsMarkUpType = (mtTag, mtMeta, mtTagErr, mtStr);
  26
  27   //\83X\83N\83\8a\83v\83g\82Ì\88ê\95\94\82Ì\89ð\90Í\82ð\83R\81[\83h\82Å\8ds\82¦\82Ü\82·
  28   TSsParseEvent = procedure (Sender: TObject; const Script: String;
  29     var Len: integer; var MarkType: TSsMarkUpType; var Extra: String) of object;
  30
  31   //\97á\8aO\83N\83\89\83X
  32   ESsParserError = class(Exception);
  33
  34   //\93à\95\94\82Å\8eg\97p\82·\82é\83N\83\89\83X\82Å\82·
  35   TSsMarkUp = class(TObject)
  36   private
  37     FExtra: String;
  38     FStr: String;
  39     FMarkUpType: TSsMarkUpType;
  40     procedure SetExtra(const Value: String);
  41   public
  42     constructor Create(MarkUpType: TSsMarkUpType; Str: String; Extra: String = '');
  43     property MarkUpType: TSsMarkUpType read FMarkUpType;
  44     property Str: String read FStr;
  45     property Extra: String read FExtra write SetExtra;
  46   end;
  47
  48   //SsParser\82Ì\96{\91Ì
  49   TSsParser = class(TComponent)
  50   private
  51     FTagPattern: TStrings;    //SS\83^\83O\83p\83^\81[\83\93\95¶\8e\9a\97ñ
  52     FMetaPattern: TStrings;   //SS\83\81\83^\95¶\8e\9a\97ñ\83p\83^\81[\83\93\95¶\8e\9a\97ñ
  53     FInputString: String; //\93ü\97Í\82µ\82½\95¶\8e\9a\97ñ
  54     FMarkUpList: TList;
  55     FLeaveEscape: boolean;
  56     FEscapeInvalidMeta: boolean;
  57     FOnParse: TSsParseEvent;
  58     procedure SetInputString(const Value: String);
  59     function GetCount: integer;
  60     function GetExtra(Index: integer): String;
  61     function GetMarkUpType(Index: integer): TSsMarkUpType;
  62     function GetStr(Index: integer): String;
  63     procedure SetExtra(Index: integer; const Value: String);
  64     procedure ClearList;
  65     procedure SetMetaPattern(const Value: TStrings);
  66     procedure SetTagPattern(const Value: TStrings);
  67     procedure SetOnParse(const Value: TSsParseEvent);
  68     function GetFirstChar(const Str: String): String;
  69     function ChopFirstChar(var Str: String): String;
  70   protected
  71     procedure BeginParse;
  72   public
  73     constructor Create(AOwner: TComponent); override;
  74     destructor Destroy; override;
  75     function MatchP(PStr, PPattern: PChar): integer;
  76     function Match(Str, Pattern: String): integer;
  77     function GetParam(Tag: String; const Index: integer): String;
  78     function EscapeParam(const Param: String): String;
  79     property Count: integer read GetCount;
  80     property MarkUpType[Index: integer]: TSsMarkUpType read GetMarkUpType;
  81     property Str[Index: integer]: String read GetStr; default;
  82     property Extra[Index: integer]: String read GetExtra write SetExtra;
  83     property InputString: String read FInputString write SetInputString;
  84   published
  85     { Published \90é\8c¾ }
  86     //\83X\83N\83\8a\83v\83g\89ð\90Í\82Ì\83p\83^\81[\83\93\82ð\8e¦\82·\81B\83h\83L\83\85\83\81\83\93\83g\8eQ\8fÆ
  87     property TagPattern: TStrings read FTagPattern write SetTagPattern;
  88     property MetaPattern: TStrings read FMetaPattern write SetMetaPattern;
  89     //mtStr\92\86\82Ì\81u\\\81v\82â\81u\%\81v\82Æ\82¢\82Á\82½\95¶\8e\9a\97ñ\82ð\81u\\81v\81u%\81v\82É\95Ï\8a·\82¹\82¸\95ú\92u\82·\82é\81B
  90     property LeaveEscape: boolean read FLeaveEscape write FLeaveEscape
  91       default true;
  92     //%\88È\8d~\82Ì\95¶\8e\9a\97ñ\82ªMetaPattern\82Å\89ð\90Í\82Å\82«\82È\82©\82Á\82½\82Æ\82«\81A%\82ð\%\82É\95Ï\8a·\82·\82é
  93     property EscapeInvalidMeta: boolean read FEscapeInvalidMeta
  94       write FEscapeInvalidMeta default false;
  95     //\89ð\90Í\82Ì\88ê\95\94\82ð\83p\83^\81[\83\93\82Å\82Í\82È\82Object Pascal\82Å\8f\88\97\9d\82·\82é\82½\82ß\82Ì\83C\83x\83\93\83g
  96     property OnParse: TSsParseEvent read FOnParse write SetOnParse;
  97   end;
  98
  99 procedure Register;
 100
 101 implementation
 102
 103 procedure Register;
 104 begin
 105   RegisterComponents('Samples', [TSsParser]);
 106 end;
 107
 108 { TSsParser }
 109
 110 procedure TSsParser.BeginParse;
 111 var Str, Talk, T, Ex: String;
 112     i, Le: integer;
 113     IsErr: boolean;
 114     Mt: TSsMarkUpType;
 115     PStr: PChar;
 116 begin
 117   ClearList;
 118   Str := FInputString; //\8f\88\97\9d\82·\82é\82×\82«\95¶\8e\9a\97ñ\82ð\90Ý\92è
 119   //\95¶\8e\9a\97ñ\82Ì\8dÅ\8cã\82ªLeadByte\82Å\8fI\82í\82é\95s\90³\82È\95¶\8e\9a\97ñ\82Å\81A\8f\82È\82\82Æ\82à\83A\83N\83Z\83X\88á\94½\82ª
 120   //\8fo\82È\82¢\82æ\82¤\82É\82·\82é\82½\82ß\82Ì\8f\88\92u\81B(\8c\8b\89Ê\82ª\82Ç\82¤\82È\82é\82©\82Í\95Û\8fØ\82µ\82È\82¢)
 121   Str := Str + #0#0;
 122   if Length(Str) = 0 then Exit;
 123   PStr := PChar(Str);
 124   Talk := '';
 125   while PStr^ <> #0 do begin
 126     if PStr^ = '\' then begin
 127       Inc(PStr);
 128       if PStr^ = '\' then
 129       begin
 130         //"\\"\82É\82æ\82é\83G\83X\83P\81[\83v
 131         if FLeaveEscape then
 132           Talk := Talk + '\\'
 133         else
 134           Talk := Talk + '\';
 135         Inc(PStr);
 136         Continue;
 137       end else if PStr^ = '%' then
 138       begin
 139         //"\%"\82É\82æ\82é\83G\83X\83P\81[\83v
 140         if FLeaveEscape then
 141           Talk := Talk + '\%'
 142         else
 143           Talk := Talk + '%';
 144         Inc(PStr);
 145         Continue;
 146       end else
 147       begin
 148         Dec(PStr);
 149         //\83^\83O\82ç\82µ\82¢
 150         //\83C\83x\83\93\83g\94\8ds
 151         Le := 0;
 152         Ex := '';
 153         IsErr := false;
 154         if Assigned(FOnParse) then begin
 155           FOnParse(Self, String(PStr), Le, Mt, Ex);
 156           if Le > 0 then begin
 157             if (Mt <> mtTag) and (Mt <> mtTagErr) then begin
 158               raise ESsParserError.Create('\90³\82µ\82¢\83G\83\8c\83\81\83\93\83g\83^\83C\83v\82ð\95Ô\82µ\82Ä\82\82¾\82³\82¢');
 159               Exit;
 160             end;
 161             if Mt = mtTagErr then IsErr := true;
 162           end;
 163         end;
 164         if Le <= 0 then begin
 165           for i := 0 to FTagPattern.Count-1 do begin
 166             T := FTagPattern[i];
 167             if Length(T) = 0 then Continue;
 168             IsErr := false;
 169             if T[1] = '!' then begin
 170               IsErr := true;
 171               T[1] := '\';
 172             end else if T[1] <> '\' then
 173               raise ESsParserError.CreateFmt('TagPattern\95\\8bL\83~\83X - %d\8ds\96Ú', [i+1]);
 174             Le := MatchP(PStr, PChar(T));
 175             if Le > 0 then Break;
 176           end;
 177         end;
 178         if Length(Talk) > 0 then begin
 179           FMarkUpList.Add(TSsMarkUp.Create(mtStr, Talk));
 180           Talk := '';
 181         end;
 182         if Le > 0 then begin
 183           //\89½\82ç\82©\82Ì\83^\83O\83p\83^\81[\83\93\82É\83}\83b\83`
 184           T := Copy(String(PStr), 1, Le);
 185           Inc(PStr, Le);
 186           if IsErr then
 187             FMarkUpList.Add(TSsMarkUp.Create(mtTagErr, T, Ex))
 188           else
 189             FMarkUpList.Add(TSsMarkUp.Create(mtTag, T, Ex));
 190         end else begin
 191           //\8e\9f\82Ì1\95¶\8e\9a\82ð\8aÜ\82ß\82Ä\83G\83\89\81[
 192           Inc(PStr); // '\'\94ò\82Î\82·
 193           if PStr^ in LeadBytes then
 194           begin
 195             T := '\' + Copy(String(PStr), 1, 2);
 196             Inc(PStr, 2);
 197           end else
 198           begin
 199             T := '\' + PStr^;
 200             Inc(PStr);
 201           end;
 202           FMarkUpList.Add(TSsMarkUp.Create(mtTagErr, T));
 203         end;
 204       end;
 205     end else if (PStr^ = '%') then begin
 206       //\83C\83x\83\93\83g\90¶\90¬
 207       Le := 0; Ex := '';
 208       if Assigned(FOnParse) then begin
 209         FOnParse(Self, String(PStr), Le, Mt, Ex);
 210         if Le > 0 then begin
 211           if Mt <> mtMeta then begin
 212             raise ESsParserError.Create('\90³\82µ\82¢\83G\83\8c\83\81\83\93\83g\83^\83C\83v\82ð\95Ô\82µ\82Ä\82\82¾\82³\82¢');
 213             Exit;
 214           end;
 215           Dec(Le); // \90æ\93ª\82Ì'%'\82Ì\92·\82³\82ð\83J\83b\83g
 216         end;
 217       end;
 218       Inc(PStr); // '%'\82ª\94ò\82Ô
 219       if Le <= 0 then
 220       begin
 221         for i := 0 to FMetaPattern.Count-1 do
 222         begin
 223           if Length(FMetaPattern[i]) = 0 then
 224             Continue;
 225           Le := MatchP(PStr, PChar(FMetaPattern[i]));
 226           if Le > 0 then
 227             Break;
 228         end;
 229       end;
 230       if Le > 0 then
 231       begin
 232         if Length(Talk) > 0 then
 233         begin
 234           FMarkUpList.Add(TSsMarkUp.Create(mtStr, Talk));
 235           Talk := '';
 236         end;
 237         T := Copy(String(PStr), 1, Le);
 238         Inc(PStr, Le);
 239         FMarkUpList.Add(TSsMarkUp.Create(mtMeta, '%' + T, Ex));
 240       end else
 241       begin
 242         //%\88È\8d~\82ª\83\81\83^\95¶\8e\9a\97ñ\82Å\82Í\82È\82¢\8fê\8d\87
 243         if FEscapeInvalidMeta then
 244           Talk := Talk + '\%'
 245         else
 246           Talk := Talk + '%';
 247         Continue;
 248       end;
 249     end else begin
 250       if PStr^ in LeadBytes then
 251       begin
 252         Talk := Talk + Copy(String(PStr), 1, 2);
 253         Inc(PStr, 2);
 254       end else
 255       begin
 256         Talk := Talk + PStr^;
 257         Inc(PStr);
 258       end;
 259     end;
 260   end; // of while
 261   if Length(Talk) > 0 then FMarkUpList.Add(TSsMarkUp.Create(mtStr, Talk));
 262 end;
 263
 264 function TSsParser.ChopFirstChar(var Str: String): String;
 265 begin
 266   Result := GetFirstChar(Str);
 267   Delete(Str, 1, Length(Result));
 268 end;
 269
 270 procedure TSsParser.ClearList;
 271 var i: integer;
 272 begin
 273   for i := FMarkUpList.Count-1 downto 0 do begin
 274     TSsMarkUp(FMarkUpList[i]).Free;
 275   end;
 276   FMarkUpList.Free;
 277   FMarkUpList := TList.Create;
 278 end;
 279
 280 constructor TSsParser.Create(AOwner: TComponent);
 281 begin
 282   inherited;
 283   FTagPattern := TStringList.Create;
 284   FMetaPattern := TStringList.Create;
 285   FMarkUpList := TList.Create;
 286   FLeaveEscape := true;
 287 end;
 288
 289 destructor TSsParser.Destroy;
 290 begin
 291   inherited;
 292   FTagPattern.Free;
 293   FMetaPattern.Free;
 294   ClearList;
 295   FMarkUpList.Free;
 296 end;
 297
 298 function TSsParser.EscapeParam(const Param: String): String;
 299 begin
 300   //StringReplace\82ÍMBCS\82É\91Î\89\9e\82µ\82Ä\82¢\82é
 301   Result := StringReplace(Param, '\', '\\', [rfReplaceAll]);
 302   Result := StringReplace(Param, ']', '\]', [rfReplaceAll]);
 303 end;
 304
 305 function TSsParser.GetCount: integer;
 306 begin
 307   Result := FMarkUpList.Count;
 308 end;
 309
 310 function TSsParser.GetExtra(Index: integer): String;
 311 begin
 312   if (Index >= 0) and (Index <= FMarkUpList.Count-1) then
 313     Result := TSsMarkUp(FMarkUpList[Index]).Extra
 314   else
 315     Result := '';
 316 end;
 317
 318 function TSsParser.GetFirstChar(const Str: String): String;
 319 begin
 320   //SJIS\82ð\8dl\97¶\82µ\82Ä\8dÅ\8f\89\82Ì\95¶\8e\9a\82ð\90Ø\82è\8fo\82·
 321   if Length(Str) <= 1 then begin
 322     Result := Str;
 323   end else begin
 324     if ByteType(Str, 1) = mbLeadByte then begin
 325       Result := Str[1] + Str[2];
 326     end else begin
 327       Result := Str[1];
 328     end;
 329   end;
 330 end;
 331
 332 function TSsParser.GetMarkUpType(Index: integer): TSsMarkUpType;
 333 begin
 334   if (Index >= 0) and (Index <= FMarkUpList.Count-1) then
 335     Result := TSsMarkUp(FMarkUpList[Index]).MarkUpType
 336   else
 337     raise ESsParserError.Create('\83C\83\93\83f\83b\83N\83X\82ª\94Í\88Í\82ð\82±\82¦\82Ä\82¢\82Ü\82·');
 338 end;
 339
 340 function TSsParser.GetParam(Tag: String;
 341   const Index: integer): String;
 342 var ParamCount: integer;
 343     First, Param: String;
 344     Escape, Inside: boolean;
 345 begin
 346   if Index <= 0 then Exit;
 347   Inside := false;
 348   ParamCount := 0;
 349   Escape := false;
 350   repeat
 351     First := ChopFirstChar(Tag);
 352     if Inside then begin
 353       if Escape then begin
 354         if First = '\' then Param := Param + '\'
 355         else if First = ']' then Param := Param + ']'
 356         else Param := Param + '\' + First;
 357         Escape := false;
 358       end else if First = '\' then
 359         Escape := true
 360       else if First = ']' then
 361         Inside := false
 362       else begin
 363         Escape := false;
 364         Param := Param + First;
 365       end;
 366     end else if First = '[' then begin
 367       Inside := true;
 368       Escape := false;
 369       Param := '';
 370       Inc(ParamCount);
 371     end;
 372   until (First = '') or ((ParamCount = Index) and not Inside);
 373   if ((ParamCount = Index) and not Inside) then
 374     Result := Param
 375   else
 376     Result := '';
 377 end;
 378
 379 function TSsParser.GetStr(Index: integer): String;
 380 begin
 381   if (Index >= 0) and (Index <= FMarkUpList.Count-1) then
 382     Result := TSsMarkUp(FMarkUpList[Index]).Str
 383   else
 384     Result := '';
 385 end;
 386
 387 function TSsParser.Match(Str, Pattern: String): integer;
 388 begin
 389   if (Length(Str) = 0) or (Length(Pattern) = 0) then
 390     Result := 0
 391   else
 392     Result := MatchP(@Str[1], @Pattern[1]);
 393 end;
 394
 395 function TSsParser.MatchP(PStr, PPattern: PChar): integer;
 396 var Matched, F, Escape: boolean;
 397 begin
 398   Matched := true;
 399   Result := 0;
 400   while Matched and (PPattern^ <> #0) do begin
 401     if PPattern^ = '%' then
 402     begin
 403       Inc(PPattern);
 404       case PPattern^ of
 405         '%':
 406           begin
 407             if PStr^ = '%' then
 408             begin
 409               Inc(Result);
 410               Inc(PStr);
 411               Inc(PPattern);
 412             end else
 413             begin
 414               Matched := false;
 415               Break;
 416             end;
 417           end;
 418         'd':
 419           begin
 420             if PStr^ in ['0' .. '9'] then
 421             begin
 422               Inc(Result);
 423               Inc(PStr);
 424               Inc(PPattern);
 425             end else
 426               Matched := false;
 427           end;
 428         'D':
 429           begin
 430             if PStr^ in ['0' .. '9'] then
 431             begin
 432               while PStr^ in ['0' .. '9'] do
 433               begin
 434                 Inc(Result);
 435                 Inc(PStr);
 436               end;
 437               Inc(PPattern);
 438             end else
 439               Matched := false;
 440           end;
 441         'b': //'[]'\82Å\88Í\82Ü\82ê\82½\95¶\8e\9a\97ñ\81B
 442           begin
 443             if PStr^ <> '[' then
 444             begin
 445               Matched := false;
 446             end else
 447             begin
 448               F := false;
 449               Escape := false; //\83G\83X\83P\81[\83v\92\86
 450               Inc(PStr);   // '[' \82Ì\95ª
 451               Inc(Result); // '[' \82Ì\95ª
 452               repeat
 453                 if Escape then
 454                 begin
 455                   Escape := false;
 456                 end else
 457                 begin
 458                   if PStr^ = '\' then Escape := true;
 459                   if PStr^ = ']' then F := true;
 460                 end;
 461                 if PStr^ in LeadBytes then
 462                 begin
 463                   Inc(Result, 2);
 464                   Inc(PStr, 2);
 465                 end else
 466                 begin
 467                   Inc(Result);
 468                   Inc(PStr);
 469                 end;
 470               until (PStr^ = #0) or F;
 471               if not F then
 472                 Matched := false;
 473             end;
 474             Inc(PPattern);
 475           end;
 476         'm':
 477           begin
 478             if not (PStr^ in LeadBytes) then
 479             begin
 480               Inc(PPattern);
 481               Inc(PStr);
 482               Inc(Result);
 483             end else Matched := false;
 484           end;
 485         'M':
 486           begin
 487             if (PStr^ in LeadBytes) then
 488             begin
 489               Inc(PPattern);
 490               Inc(PStr, 2);
 491               Inc(Result, 2);
 492             end else Matched := false;
 493           end;
 494         '.':
 495           if (PStr^ in LeadBytes) then
 496           begin
 497             Inc(PPattern);
 498             Inc(PStr, 2);
 499             Inc(Result, 2);
 500           end else
 501           begin
 502             Inc(PPattern);
 503             Inc(PStr);
 504             Inc(Result);
 505           end;
 506         else
 507           if PStr^ = '%' then
 508           begin
 509             Inc(PStr);
 510             Inc(Result);
 511           end else
 512           begin
 513             Matched := false;
 514           end;
 515       end // of case
 516     end else
 517     begin
 518       if PStr^ <> PPattern^ then
 519         Matched := false
 520       else
 521       begin
 522         Inc(Result);
 523         Inc(PStr);
 524         Inc(PPattern);
 525       end;
 526     end;
 527   end; //of while
 528   if not Matched then Result := 0;
 529 end;
 530
 531 procedure TSsParser.SetExtra(Index: integer; const Value: String);
 532 begin
 533   if (Index >= 0) and (Index <= FMarkUpList.Count-1) then
 534     TSsMarkUp(FMarkUpList[Index]).Extra := Value
 535   else
 536     raise ESsParserError.Create('\83C\83\93\83f\83b\83N\83X\82ª\94Í\88Í\82ð\82±\82¦\82Ä\82¢\82Ü\82·');
 537 end;
 538
 539 procedure TSsParser.SetInputString(const Value: String);
 540 begin
 541   FInputString := Value;
 542   BeginParse;
 543 end;
 544
 545 procedure TSsParser.SetMetaPattern(const Value: TStrings);
 546 begin
 547   FMetaPattern.Assign(Value);
 548 end;
 549
 550 procedure TSsParser.SetOnParse(const Value: TSsParseEvent);
 551 begin
 552   FOnParse := Value;
 553 end;
 554
 555 procedure TSsParser.SetTagPattern(const Value: TStrings);
 556 begin
 557   FTagPattern.Assign(Value);
 558 end;
 559
 560 { TSsMarkUp }
 561
 562 constructor TSsMarkUp.Create(MarkUpType: TSsMarkUpType; Str: String; Extra: String = '');
 563 begin
 564   FMarkUpType := MarkUpType;
 565   FStr := Str;
 566   FExtra := Extra;
 567 end;
 568
 569 procedure TSsMarkUp.SetExtra(const Value: String);
 570 begin
 571   FExtra := Value;
 572 end;
 573
 574 end.