📄 utokenparser.pas
字号:
{$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 + -