utokenparser.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

 inc(FAbsoluteLastTokenStartPos.Row, 1 + FStartPos.Row);
 if FStartPos.Column > 1 then
  inc(FAbsoluteLastTokenStartPos.Column, FStartPos.Column - 1);
 //save it also as the effective position
 FEffectiveLastTokenFile := nil;
 FEffectiveLastTokenStartPos := FAbsoluteLastTokenStartPos;
end;




{$IFOPT C+}

{Returns if the stack of positions is empty.
~result if the stack of positions is empty }
function TTokenParser.PositionStackEmpty: Boolean;
begin
 Result := FTokenPosStackFreeIndex = 0;
end;

{$ENDIF}




{Sets the effective file and position of the last token.
~param TheFile the effective file from which the token was read
~param Pos     the effective position of the token }
procedure TTokenParser.SetEffectivePositionOfLastToken(TheFile: TPascalFile;
                                                       Pos: TPosition);
begin
 FEffectiveLastTokenFile := TheFile;
 FEffectiveLastTokenStartPos := Pos;
end;


















{Raises a Parser-Exception at the current absolute position. Before this
 happens, the application will be stopped if it is being debugged.
~param ExceptType the general reason of the error
~param Msg        the error message
~exception EParseException This is the reason of this procedure. }
procedure TTokenParser.Exception(ExceptType: TExceptType; const Msg: String);
var       Exception   :EParseException;       //the exception
          Positions   :TTokenPosition;        //positions of the last token
begin
 //create Exception-object
 Exception := EParseException.Create(ExceptType, Msg);
 try

   //get positions of the last token and assign them
   Positions := GetLastTokenPositions;
//   Exception.TheFile := nil;
   Exception.ErrorPosition := Positions.FPosition;
   Exception.EffectiveFile := Positions.FEffectiveFile;
   Exception.EffectiveErrorPosition := Positions.FEffectivePosition;
 except
   Exception.Free;
   raise;
 end;

 if IsDebuggerPresent then     //application is being debugged?
  asm int 3 end;                 //stop it (this is a hard break point)

 //initialize and raise exception
 raise InitExceptionObject(Exception);
end;

{Raises a Parser-Exception with a formatted message at the current absolute
 position.
~param ExceptType the general reason of the error
~param Fmt        the format of the error message
~param Params     the values for the formatted error message
~exception EParseException This is the reason of this procedure. }
procedure TTokenParser.ExceptionFmt(ExceptType: TExceptType;
                                    const Fmt: String;
                                    const Params: array of const);
begin
 Exception(ExceptType, Format(Fmt, Params));
end;

{Raises a Parser-Exception (EParseException) at the positions. Before this
 happens, the application will be stopped if it is being debugged.
~param Positions  the positions where the error occured
~param ExceptType the general reason of the error
~param Msg        the error message
~exception EParseException This is the reason of this procedure. }
procedure TTokenParser.ExceptionPos(const Positions: TTokenPosition;
                                    ExceptType: TExceptType;
                                    const Msg: String);
var       Exception   :EParseException;       //the exception
begin
 //create Exception-object
 Exception := EParseException.Create(ExceptType, Msg);
 try
//   Exception.TheFile := nil;                //assign the positions
   Exception.ErrorPosition := Positions.FPosition;
   Exception.EffectiveFile := Positions.FEffectiveFile;
   Exception.EffectiveErrorPosition := Positions.FEffectivePosition;
 except
   Exception.Free;
   raise;
 end;

 if IsDebuggerPresent then     //application is being debugged?
  asm int 3 end;                 //stop it (this is a hard break point)

 //initialize and raise exception
 raise InitExceptionObject(Exception);
end;

{Raises a Parser-Exception (EParseException) with a formatted message at the
 positions.
~param Positions  the positions where the error occured
~param ExceptType the general reason of the error
~param Fmt        the format of the error message
~param Params     the values for the formatted error message
~exception EParseException This is the reason of this procedure. }
procedure TTokenParser.ExceptionPosFmt(const Positions: TTokenPosition;
                                       ExceptType: TExceptType;
                                       const Fmt: String;
                                       const Params: array of const);
begin
 ExceptionPos(Positions, ExceptType, Format(Fmt, Params));
end;


{Generates a warning message at the current position.
~param WarnType the general reason of the "error"
~param Msg      the warning message
~exception EParseException if ~[link HandleWarningMessage] hasn't been
                           overridden }
procedure TTokenParser.WarningMessage(WarnType: TExceptType;
                                      const Msg: String);
var       Exception   :EParseException;       //the object for the warning
          Positions   :TTokenPosition;        //positions of the last token
begin
 //create Exception/Warning-object
 Exception := EParseException.Create(WarnType, Msg);
 try

   //get positions of the last token and assign them
   Positions := GetLastTokenPositions;
//   Exception.TheFile := nil;
   Exception.ErrorPosition := Positions.FPosition;
   Exception.EffectiveFile := Positions.FEffectiveFile;
   Exception.EffectiveErrorPosition := Positions.FEffectivePosition;
 except
   Exception.Free;
   raise;
 end;

 //initialize it with all information and handle the warning message
 HandleWarningMessage(InitExceptionObject(Exception));
end;

{Generates a formatted warning message at the current position.
~param WarnType the general reason of the "error"
~param Fmt      the format of the warning message
~param Params   the values for the formatted warning message
~exception EParseException if ~[link HandleWarningMessage] hasn't been
                           overridden }
procedure TTokenParser.WarningMessageFmt(WarnType: TExceptType;
                                         const Fmt: String;
                                         const Params: array of const);
begin
 WarningMessage(WarnType, Format(Fmt, Params));
end;






































{Returns the next token (after the current position).
~param ResToken returns the found token or '' if no token could be found
~result if a token could be found }
function TTokenParser.DoDoGetToken(var ResToken: String): Boolean;

         //the strings to end comments
const    CommentEnds: array[Boolean] of String = ('}', '*)');

var      LineCount   :Integer;   //number of lines in the parsed file


 {Skips the code to the end of the comment.
 ~param BraceStar if it is a comment in the form "(*" instead of "{" to skip }
 procedure SeekToEndOfComment(BraceStar: Boolean);
 var       Search            :String;     //the string to end the comments
           Line              :String;     //each line until end found
           CharIndex         :Integer;    //character of the end of the comment
 begin
  inc(FTokenSearchPos.Row);               //comments spans the whole line
  FTokenSearchPos.Column := 1;            //resume at the beginning of the next
  if FTokenSearchPos.Row < LineCount then //lines left?
   begin
    Search := CommentEnds[BraceStar];       //this must be found
    repeat                                  //search the end of the comment
      Line := FLines[FTokenSearchPos.Row];    //get the line
      CharIndex := pos(Search, Line);         //comment end in it?
      inc(FTokenSearchPos.Row);
    until (CharIndex <> 0) or (FTokenSearchPos.Row >= LineCount);
    if CharIndex <> 0 then                  //end of comment found?
     begin
      //resume getting tokens after the comment
      FTokenSearchPos.Column := CharIndex + Length(Search);
      dec(FTokenSearchPos.Row);               //restore the line
     end;
   end;
 end;


 {Searches the next token in the file.
 ~param ResToken out: a part of the line in the code beginning with the token
 ~result if a token could be found }
 function SearchToken(var ResToken: String): Boolean;
 var      Token      :String;    //the token to get

  {Skips the comment.
  ~param CommentCharacter the first character starting the comment
  ~param Offset           the offset/index of the character in Token }
  procedure SkipComment(CommentCharacter: Char; Offset: Integer);
  var       BraceStar  :Boolean;   //if it is a "(*"-comment
            CommentEnd :Integer;   //the end of the commment
  begin
   if CommentCharacter = '/' then  //comment to end of line?
    begin
     inc(FTokenSearchPos.Row);       //resume in the next line
     FTokenSearchPos.Column := 1;
    end
   else
    begin
     BraceStar := CommentCharacter <> '{';  //what kind of comment?
     //get end of comment
     CommentEnd := SearchString(CommentEnds[BraceStar], Token,
                                1 + Offset + Length(CommentEnds[BraceStar]));
     if CommentEnd <> 0 then         //end found in this line?
      //set position after the comment
      inc(FTokenSearchPos.Column,
          CommentEnd - 1 + Length(CommentEnds[BraceStar]))
     else
      SeekToEndOfComment(BraceStar);   //skip to the end of the comment
    end;
  end;

 var      pc         :PChar;     //runner through the text
 begin
  repeat                         //until token found
    Token := FLines[FTokenSearchPos.Row];
    //delete everything before the search position
    Delete(Token, 1, FTokenSearchPos.Column - 1);

    pc := Pointer(Token);          //run through the remnant of the line
    //skip whitespaces
    while (not assigned(pc) or (pc^ in [#0..#31, ' '])) and
          (FTokenSearchPos.Row < LineCount) do
     begin
      if assigned(pc) then
       while pc^ in [#1..#31, ' '] do //skip whitespaces in this line
        inc(pc);
      if not assigned(pc) or (pc^ = #0) then   //end of line reached?
       begin
        FTokenSearchPos.Column := 1; //resume at the beginning
        inc(FTokenSearchPos.Row);    //of the next line
        if FTokenSearchPos.Row < LineCount then
         Token := FLines[FTokenSearchPos.Row]
        else
         Token := '';
        pc := Pointer(Token);
       end;
     end;

    if assigned(pc) and            //is a comment (and not for the compiler)?
       (((pc^ = '/') and (PChar(Cardinal(pc) + 1)^ = '/')) or
        (((pc^ = '{') or
          ((pc^ = '(') and (PChar(Cardinal(pc) + 1)^ = '*'))) and
         (PChar(Cardinal(pc) + 1 + Cardinal(Ord(pc^ = '(')))^ <> '$'))) then
     begin
      SkipComment(pc^, pc - Pointer(Token));  //skip the comment
      pc := nil;                     //start search again after it
     end;

  //until token found or end of file reached
  until (FTokenSearchPos.Row >= LineCount) or
        (assigned(pc) and (pc^ in [#33..#255]));


  assert((FTokenSearchPos.Row >= LineCount) or assigned(pc));

  Result := (FTokenSearchPos.Row < LineCount) and (pc^ in [#33..#255]);
  if Result then                //found a valid token in the data?
   begin
    //set position of the token
    inc(FTokenSearchPos.Column, pc - Pointer(Token));
    //delete everything before the token
    Delete(Token, 1, pc - Pointer(Token));
    //save this as the position of the token
    SetPositionOfLastToken;
   end
  else
   Token := '';

  ResToken := Token;
 end;


var      Token       :String;    //the token to get
         pc          :PChar;     //runner through the token
         BraceStar   :Boolean;   //if it is a "(*"-comment
         CommentEnd  :Integer;   //the end of the commment
begin
 LineCount := Self.LineCount;    //get number of lines in the file once

 Token := '';                    //no token found so far

 if FTokenSearchPos.Column < 1 then
  FTokenSearchPos.Column := 1;

 Result := (FTokenSearchPos.Row < LineCount) and //end of data not reached?
           SearchToken(Token);   //and a token found?
 Assert(Result = (Token <> ''));

 if Result then                  //token found?
  if Token[1] in IdentifierChars then //identifier or number (not hex)?
   begin
    if Token[1] in ['0'..'9'] then      //numbers
     begin
      pc := Pointer(Token);
      Inc(pc);            //run through the number
      while (pc^ in ['0'..'9']) or
            // '.' is allowed, but '..' not (SubRanges: 0..10)
            ((pc^ = '.') and (PChar(Cardinal(pc) + 1)^ <> '.')) do
       Inc(pc);
      if pc^ in ['E', 'e'] then         //exponent given?
       begin
        Inc(pc);
        if pc^ in ['+', '-'] then         //skip sign
         Inc(pc);
        if pc^ in ['0'..'9'] then         //number follows?
         begin
          Inc(pc);
          while pc^ in ['0'..'9'] do        //skip exponent
           Inc(pc);
         end
        else
         begin
          Dec(pc);                        //move back
          if pc^ in ['+', '-'] then
           Dec(pc);
         end;
       end;
      //search next token behind this
      Inc(FTokenSearchPos.Column, pc - Pointer(Token));
      Token := Copy(Token, 1, pc - Pointer(Token)); //extract number
     end
    else
     begin                              //identifiers
      pc := Pointer(Token);
      Inc(pc);                            //run through identifier
      while pc^ in IdentifierChars do
       Inc(pc);

      Token := Copy(Token, 1, pc - Pointer(Token)); //extract identifier
      //search next token behind the identifier
      Inc(FTokenSearchPos.Column, Length(Token));
     end;
   end
  else
   if (Token[1] = '{') or                          //is a compiler option?
      ((Token[1] = '(') and // (length(Token) > 1) and
       (Token[2] = '*')) then
    begin


     BraceStar := Token[1] <> '{';               //what kind?
     //search the end of the comment in the current line
     CommentEnd := SearchString(CommentEnds[BraceStar], Token,
                                1 + Length(CommentEnds[BraceStar]));
     if CommentEnd <> 0 then                     //end found in this line?
      begin                                        //get the whole comment