uwparser.pas

Delphi脚本控件

  Column := SrcToken.Column;
  Tag := SrcToken.Tag;
end;

// this is create constructor of the scanner. no changes to the
// inherited create, only initialization of internal and external
// variables
constructor TWParser.Create(AOwner: TComponent);
begin
  inherited Create( AOwner );       // create the class
  FOwnSourceStream := False;        // Don't free SourceStream when destroying
  TokenList := TList.Create;        // create the list of read token
  FKeywords := TStringList.Create;  // create the list of keywords
  FKeywords.Sorted := true;         // sort the keywords
  FAllowFigures := true;            // default figures are allowed within identifiers
  FAllowIdentifier := true;         // default no identifier is allowed
  FCaseSensitive := false;          // default no case sensitive keyword compare
  FCharacters := [];                // default there are no special chars
  FCommentLine := '//';             // the default comment begin is '//'
  FComment1Begin := '{';            // the default comment 1 block start mark is '{'
  FComment1End := '}';              // the default comment 1 block end mark is '}'
  FComment2Begin := '(*';           // the default comment 2 block start mark is '{'
  FComment2End := '*)';             // the default comment 2 block end mark is '}'
  FIdentChars := ['a'..'z', 'A'..'Z']; // first all letters are allowed within identifiers
end;

// this is destructor of the scanner. it is neccessary to free the internal
// dynamic data structures
destructor TWParser.Destroy;
begin
  FKeywords.Free;     // deallocate the memory used by the list of keywords
  ClearTokenList;     // delete all saved token
  TokenList.Free;     // deallocate the memory used by the list of read token
  if FOwnSourceStream then
    FreeAndNil(SourceStream);
  inherited Destroy;  // destroy the class
end;

// this is the main analysis method
procedure TWParser.Analyze( Source: TStream );
begin
  SourceStream := Source;               // assign the source stream
  SourceStream.Position := 0;           // set stream position to the beginning
  ClearTokenList;                       // delete old results
  SourceY := 1;                         // first row is 1
  SourceX := 1;                         // first column is 1
  CommentBlock1Phase := false;          // the scanner is not in a commant block 1 phase
  CommentBlock2Phase := false;          // the scanner is not in a commant block 2 phase
  Restart;                              // from now it is only a restart
end;

// delete the old analysis results and deallocate the used memory
procedure TWParser.ClearTokenList;
var i: Integer;
begin
  for i:= TokenList.Count downto 1 do begin  // for all saved tokens
    TToken( TokenList.Items[i-1] ).Free;     // free the last token
    TokenList.Delete( i-1 );                 // delete the list entry
  end;
end;

// compare two strings depending of case sensitive operations
function TWParser.EqualStr( First, Second: string ) : Boolean;
begin
  if not FCaseSensitive then begin      // if no case sensitive compare
    First := Uppercase( First );        // only the uppercase strings are compared
    Second := Uppercase( Second );
  end;
  Result := First=Second;               // compare the given strings
end;

// internal the allowed chars for an identifier are stored in an set of char
// this method converts the set of char into a string
function TWParser.GetAdditionalChars: string;
var i: Integer;
begin
  Result := '';                                  // first there are no additional chars
  for i := 0 to 255 do begin                     // for all possible chars
    if (Chr(i) in FIdentChars) and               // if the char in in the set
       (not (Chr(i) in ['a'..'z'])) and          // and it's not a lower case letter
       (not (Chr(i) in ['A'..'Z']))  then begin  // an d not a higer case letter
      Result := Result + Chr(i);                 // add the char to the string
    end;
  end;
end;

// get the number of read token
function TWParser.GetCount: Integer;
begin
  Result := TokenList.Count; // read token are saved in internal list
end;

// get the already read token at index Index
function TWParser.GetToken( Index: Integer ) : TToken;
begin
  if (Index < 0 ) or (Index >= Count) then begin  // if the index is invalid
    Result := nil;                                // return nil
  end else begin
    Result := TokenList.Items[Index];             // else return the token
  end;
end;

function TWParser.GetVersion: string;
begin
  Result := cVersion;
end;

// internal the special char are stored in a set of char
// this method converts the set of char into a string
function TWParser.GetSpecialChars: string;
var i: Integer;
begin
  Result := '';                          // first there are no special chars
  for i := 0 to 255 do begin             // for all possible chars
    if Chr(i) in FCharacters then begin  // if the char is in the set
      Result := Result + Chr(i);         // add the char to the string
    end;
  end;
end;

// this method tests if a string is a keyword. the keywords are defined in
// the list Keywords
function TWParser.IsKeyword( Value: string ) : Boolean;
var KeyCompare: string;
    i:          Integer;
begin
  Result := false;                        // first the string is not a keyword
  for i := 1 to FKeywords.Count do begin  // for all defined keywords
    KeyCompare := FKeywords.Strings[i-1]; // get the keyword at index i-1
    if EqualStr( Value, KeyCompare) then begin  // if the two strings are equal
       Result := true;                          // the given string is a keyword
       Break;                                   // exit the for loop
    end;
  end;
end;

// get the net char without reading it
function  TWParser.LookAheadChar: Char;
var AheadStr: string;
begin
  AheadStr := LookAheadStr( 1 );  // simply get the next string with length 1
  if Length(AHeadStr) <> 1 then begin
    Result := #10;
  end else begin
    Result := AheadStr[1];        // get only the first char
  end;
end;

// get the next count char without reading it
function  TWParser.LookAheadStr( Count: Integer) : string;
var SavePos, Size: LongInt;
    AheadArray: array[0..255] of char;
begin
  SavePos := SourceStream.Position;  // save the actual stream position
  Size := SourceStream.Size;

  if Size = SavePos then
  begin
    Result := '';                  // the result string will be empty
    Exit;
  end;

  try                                // maybe the end of stream is reached
    FillCHar( AheadArray, SizeOf(Aheadarray), 0 ); // fill the result array with #0
    SourceStream.ReadBuffer( AheadArray, Count );  // read the next count chars
    Result := StrPas( AheadArray );  // convert the result to a pascal string
  except
    on EReadError do begin           // if a read error occures
      Result := '';                  // the result string will be empty
    end;
  end;
  SourceStream.Position := SavePos;  // reset the stream position
end;

// this method reads a char from the source stream and adds it to the
// actual token text
procedure TWParser.ProcessChar;
var ch: Char;
begin
  ReadCh( ch );                 // read a char
  EAText := EAText + ch;        // add the char to the actual token text
  if (not Eof) and (ch in LeadBytes) then begin // if a lead byte is read
    ReadCh( ch );               // again read a char
    EAText := EAText + ch;      // and add the char to the actual token text
  end;
end;

// read a new char from the input stream
// the char #10 is used as global linefeed; MAC file has only #13 as linefeed,
// havn't they? Sorry!
// this procedure count the actual row and colum of the input stream.
procedure TWParser.ReadCh( var ch: Char );
begin
  try
    SourceStream.ReadBuffer( ch, SizeOf(ch) ); // read the next char
  except
    on EReadError do begin
      Eof := true;
      ch := #0;
    end;
  end;
  if not Eof then begin            // if not Eof the calculate row/column
    // if a combination #13#10 is detected (PC linefeed is cruel!)
    if (ch=#13) and (LookAheadChar = #10) then begin
      try
        SourceStream.ReadBuffer( ch, SizeOf(ch) ); // skip the first CR/LF char
      except
        on EReadError do begin                     // be careful of eof!
          Eof := true;
          ch := #10;                               // the result is sure a normal LF
        end;
      end;
    end;
    if (ch=#13) or (ch=#10) then begin  // if the read char is a linefeed
      Inc(SourceY, 1);                  // increment the row
      SourceX := 1;                     // next column is 1
    end else begin                      // if no lienfeed is found
      Inc(SourceX, 1);                  // increment the column
    end;
  end;
end;

// read the next token with a state machine
procedure TWParser.ReadToken;
begin
  if CommentBlock1Phase or CommentBlock2Phase then begin  // if the scanner is within a comment block 1 or 2 phase
    if CommentBlock1Phase then EAState := 18; // the first state is 18
    if CommentBlock2Phase then EAState := 19; // the first state is 19
    EARow := SourceY;              // set the col, row and position if a comment block phase is active
    EAColumn := SourceX;
    EAPosition := SourceStream.Position;
  end else begin                   // else the scanner is in normal operation mode
    EAState := 0;                  // the first state is zero
    if EAToken <> ttComment then EASubType := tsNone;
  end;
  EAText := '';  // first the token text is empty
  if Eof then begin    // if the end of stream is reached
    EAToken := ttEof;  // create a ttEof token
  end else begin
    while true do begin            // endless loop for reading, leaved by a final state
      NextChar := LookAheadChar;   // get the net char without reading it
      case EAState of              // process the char in notice to the actual state
        0: EASwitch0( NextChar );
        1: EASwitch1( NextChar );
        3: EASwitch3( NextChar );
        5: EASwitch5( NextChar );
        7: EASwitch7( NextChar );
        9: EASwitch9( NextChar );
       11: EASwitch11( NextChar );
       13: EASwitch13( NextChar );
       14: EASwitch14( NextChar );
       16: EASwitch16( NextChar );
       18: EASwitch18( NextChar );
       19: EASwitch19( NextChar );
      end;
      // check if a final state is reached
      case EAState of
        2: begin      // final state 2 represents a read identifier
             EAToken := ttIdentifier;
             Break;
           end;
        4: begin     // final state 4 represents a read integer
             EAToken := ttInteger;
             Break;
           end;
        6: begin     // final state 6 represents a read real number
             EAToken := ttReal;
             Break;
           end;
        8: begin     // final state 8 represents a read string
             EAToken := ttString;
             Break;