⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 utokenparser.pas

📁 DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen
💻 PAS
📖 第 1 页 / 共 4 页
字号:
{$IFDEF LINUX}

//Returns if this application is being debugged, at the moment always False.
function IsDebuggerPresent: Boolean;

{$ELSE}

{Returns if this application is being debugged.
~result if this application is being debugged }
function IsDebuggerPresent: BOOL; stdcall external kernel32
                                                   name 'IsDebuggerPresent';

{$ENDIF}


implementation

uses General;


{$IFDEF LINUX}

{Returns if this application is being debugged, at the moment always False.
~result if this application is being debugged, at the moment always False }
function IsDebuggerPresent: Boolean;
begin
 Result := False;
end;

{$ENDIF}




















  { * * *  ***  * * *  ***   EParseException   ***  * * *  ***  * * *  }


{Creates a new exception object with the specified data.
~param ExceptType    the general reason of the error
~param Msg           the error-message }
constructor EParseException.Create(ExceptType: TExceptType; const Msg: String);
begin
 inherited Create(Msg);                       //create the object

 FExceptType := ExceptType;                   //save the parameters
end;

{Creates a new exception object with the specified data.
~param ExceptType    the general reason of the error
~param ErrorPosition the position in the file where the error occured
~param Msg           the error-message }
constructor EParseException.CreatePos(ExceptType: TExceptType;
                                      ErrorPosition: TPosition;
                                      const Msg: String);
begin
 inherited Create(Msg);                       //create the object

 FExceptType := ExceptType;                   //save the parameters
 FErrorPosition := ErrorPosition;
 FEffectiveErrorPosition := ErrorPosition;
end;




{Extracts all information about the exception/warning.
~param Information the variable to copy the information to }
procedure EParseException.CopyInformationTo(var Information:
                                                     TParseMessageInformation);
begin
 Information.MessageKind := pmkError;         //assume it is an error
 Information.MessageType := FExceptType;      //copy all information
 Information.TheFile := FTheFile;
 Information.ErrorPosition := FErrorPosition;
 Information.EffectiveFile := FEffectiveFile;
 Information.EffectiveErrorPosition := FEffectiveErrorPosition;
 Information.Message := Message;
end;















  { * * *  ***  * * *  ***   TCommentFileParser   ***  * * *  ***  * * *  }


{Creates a new TCommentFileParser-object. }
constructor TCommentFileParser.Create;
begin
 inherited Create;             //create the object

 FOwnedContent := True;        //owning the content of the pascal data
 FLines := TStringList.Create; //create the TStringList for the pascal data
end;

{Destroys this TCommentFileParser-object. }
destructor TCommentFileParser.Destroy;
begin
 if FOwnedContent then         //content is owned and must be freed?
  FLines.Free;                   //free the content

 inherited Destroy;            //and free the object
end;







{Gets the number of lines.
~result the number of lines of pascal data }
function TCommentFileParser.GetLineCount: Integer;
begin
 Result := FLines.Count;
end;














{Raises a Parser-Exception (EParseException). Before this happens, the
 application will be stopped if it is being debugged.
~param ErrPos     the absolute (exernal) position 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 TCommentFileParser.ExceptionPos(const ErrPos: TPosition;
                                          ExceptType: TExceptType;
                                          const Msg: String);
begin
 if IsDebuggerPresent then     //application is being debugged?
  asm int 3 end;                 //stop it (this is a hard break point)

 //create, initialize and raise exception
 raise InitExceptionObject(EParseException.CreatePos(ExceptType, ErrPos, Msg));
// TConditionalParser(Self).FThisFile.InternalFileName
end;












{Initializes an Parser-Exception-Object before it gets raised. This function
 will be overridden in subclasses that have more information to set, where and
 why the error occured.
~param ExcpObj the exception object to be initialized
~result ExcpObj after the initialization }
function TCommentFileParser.InitExceptionObject(ExcpObj: Exception): Exception;
begin
 Result := ExcpObj;
end;

{Handles a warning; here: raises the exception. This method should never be
 called, only the overriding methods in descending classes.
~param ExcpObj the exception object with the warning message/information to be
               handled
~exception EParseException If not overridden by another handler. }
procedure TCommentFileParser.HandleWarningMessage(ExcpObj: Exception);
begin
 if IsDebuggerPresent then     //application is being debugged?
  asm int 3 end;                 //stop it (this is a hard break point)

 raise ExcpObj;                //raise "Warning"
end;








{Raises a Parser-Exception (EParseException) at an identifier. Before this
 happens, the application will be stopped if it is being debugged.
~param Identifier the identifier to generate the error at
~param ExceptType the general reason of the error
~param Msg        the error message
~exception EParseException This is the reason of this procedure. }
procedure TCommentFileParser.ExceptionIdent(Identifier: Tidentifier;
                                            ExceptType: TExceptType;
                                            const Msg: String);
var       Exception   :SysUtils.Exception;  //the exception
begin
 //create and initialize exception object
 Exception := InitExceptionObject(EParseException.Create(ExceptType, Msg));
 try
   if Exception is EParseException then
    begin
     EParseException(Exception).TheFile := Identifier.InFile;
     EParseException(Exception).ErrorPosition := Identifier.Position;
     EParseException(Exception).EffectiveFile := Identifier.EffectiveFile;
     EParseException(Exception).EffectiveErrorPosition :=
                                                  Identifier.EffectivePosition;
    end;
 except
   Exception.Free;
   raise;
 end;

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

 //raise the exception
 raise Exception;
end;
                
{Raises a Parser-Exception (EParseException) at an identifier.
~param Identifier the identifier to generate the error at
~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 TCommentFileParser.ExceptionIdentFmt(Identifier: Tidentifier;
                                               ExceptType: TExceptType;
                                               const Fmt: String;
                                               const Params: array of const);
begin
 ExceptionIdent(Identifier, ExceptType, Format(Fmt, Params));
end;

{Raises a Parser-Exception (EParseException) at the beginning of the file.
~param ExceptType the general reason of the error
~param Msg        the error message
~exception EParseException This is the reason of this procedure. }
procedure TCommentFileParser.ExceptionAtStart(ExceptType: TExceptType;
                                              const Msg: String);
begin
 ExceptionPos(MakePosition(0, 1), ExceptType, Msg);
end;





































{Sets the content of the file by assigning the list.
~param Content the content to use and parse }
procedure TCommentFileParser.SetContentToParse(Content: TStrings);
begin
 if FOwnedContent then                //owning current content?
  begin
   FOwnedContent := False;              //not owning it anymore
   FLines.Free;                         //free the content
  end;
 FLines := Content;                   //assign the content

 FStartPos.Row := 0;                  //start at beginning of file
 FStartPos.Column := 1;
end;


{Parses the string as pascal data. This function should only be used to parse a
 text (concatenation of previously parsed tokens) token by token. Because of
 that you should only call this function on objects of the class
 ~[linkClass TTokenParser].
~param Text                    the text to be saved as pascal data
~param RelPosRow, RelPosColumn position of the text in a file }
procedure TCommentFileParser.ParseString(const Text: String;
                                         RelPosRow: Integer = 0;
                                         RelPosColumn: Integer = 1);
begin
 assert(FOwnedContent);
// assert(ClassType = TTokenParser);
// OutputDebugString(PChar(Format('Call of ParseString on %s', [ClassName])));
 FStartPos.Row := RelPosRow;       //save start of text in a file
 FStartPos.Column := RelPosColumn;
 FLines.Clear;                     //clear data
 FLines.Append(Text);              //set the text as data
end;























{$INCLUDE ..\General\Templates\ListTemplate.inc}









  { * * *  ***  * * *  ***   TTokenParser   ***  * * *  ***  * * *  }



{$IFOPT C+}
         //maximum number of tokens in the stack to reget
var      MaxTokensOnStack: Integer = 0;           //after a pop of a position
         //maximum number of pushed positions
         MaxStackSizeOfPositions: Integer = 0;
{$ENDIF}






{Creates a new TTokenParser-object. }
constructor TTokenParser.Create;
begin
 inherited Create;                   //create the object

 FTokenOnStackIndex := -1;           //don't read tokens from stack
 FTokenStack := TTokenList.Create;   //create stack for tokens
end;

{Frees the position stack. }
destructor TTokenParser.Destroy;
begin
 FTokenStack.Free;                   //free stack of tokens
 FreeMem(FTokenPosStack);            //free the position stack

 inherited Destroy;                  //free object
end;













{Saves the position of the last read token. }
procedure TTokenParser.SetPositionOfLastToken;
begin
 //save the absolute position
 FAbsoluteLastTokenStartPos := FTokenSearchPos;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -