uwdelphiparser.pas

Delphi脚本控件

  if Count > 0 then
    for i := 0 to Count - 1 do
      if Items[i] is TClassPropertyEntry then begin
        TClassPropertyEntry(Items[i]).IsEvent := False;
        for j := 0 to Count - 1 do
          if (Items[j] is TTypeEntry) and
             (CompareText(Items[j].Name, TClassPropertyEntry(Items[i]).TypeName) = 0) and
             ((Pos('function', LowerCase(TTypeEntry(Items[j]).ExistingType)) = 1) or
              (Pos('procedure', LowerCase(TTypeEntry(Items[j]).ExistingType)) = 1))
          then
            TClassPropertyEntry(Items[i]).IsEvent := True;
      end;
end;

function TWDelphiParser.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TWDelphiParser.GetEntry(Index: Integer): TEntry;
begin
  Result := FItems[Index];
end;

procedure TWDelphiParser.AddDefaultDelphiSymbols(
  aSybmols: array of string);
var
  i : Integer;
begin
  for i := Low(aSybmols) to High(aSybmols) do
    AddSymbolEntry(aSybmols[i], '');
end;

function TWDelphiParser.AddSymbolEntry(aName,
  aValue: String): TSymbolEntry;
begin
  Result := FindSymbolEntry(aName);
  if Result = nil then begin
    Result := TSymbolEntry.Create(aName, FRootEntry, Self);
    Result.Value := aValue;
    FItems.Add(Result);
  end;
end;

function TWDelphiParser.FindSymbolEntry(aName: String): TSymbolEntry;
var
  i : Integer;
begin
  Result := nil;
  if Count > 0 then
    for i := 0 to Count - 1 do
      if (Items[i] is TSymbolEntry) then
      if (CompareText(Items[i].Name, aName) = 0) then begin
        Result := TSymbolEntry(Items[i]);
        Break;
      end;
end;

procedure TWDelphiParser.IncludeFile(aFileName : String; var aIndex : Integer);
var
  i : Integer;
  sFileName, sDirList : String;
begin
  sDirList := GetCurrentDir;
  if FSearchPath <> '' then sDirList := ';' + FSearchPath;

  if FItems.Count > 0 then
    for i := 0 to FItems.Count - 1 do
      if TEntry(FItems[i]) is TFileEntry then begin
        if sDirList <> '' then sDirList := sDirList + ';';
        sDirList := sDirList + ExtractFilePath(TFileEntry(FItems[i]).FileName);
      end;
  sFileName := ExpandFileName(FileSearch(aFileName, sDirList));
  if sFileName = '' then begin
    FErrors.Add(Format('- Error DB96D2D1 detected in file %s [%d, %d]',
                       [FFileName, Token[aIndex].Row, Token[aIndex].Column]));
    FErrors.Add('');
    FErrors.Add(Format('Include file %s not found.', [aFileName]));
    FErrors.Add('');
    raise Exception.Create('The rest of the code ignored.');
  end;
  { Save WParser and the current position into stack }
  FWParserStack.Push(FWParser, aIndex + 1, FFileName);
  { Create a new parser and initializate it }
  FWParser := TWParser.Create(Self);
  InitWParser(FCompilerVersion, FWParser);
  FFileName := sFileName;
  FWParser.Analyze(TFileStream.Create(sFileName, fmOpenRead));
  FWParser.OwnSourceStream := True;
  aIndex := -1;
end;

procedure TWDelphiParser.StepNextToken(var aIndex: Integer);
var
  S, N, V : String;
  SymbolEntry : TSymbolEntry;
  bFinish : boolean;

  procedure StepUntilCommentToken(aNames : array of string);
  var
    i, j : Integer;
  begin
    while aIndex < (FWParser.Count - 1) do begin
      if Token[aIndex].Token = ttComment then begin

        for j := Low(aNames) to High(aNames) do
          if Pos(UpperCase(aNames[j]), UpperCase(Token[aIndex].Text)) = 1
          then begin
            aIndex := aIndex + 1;
            { ... aName <...> }
            Exit;
          end;
      end;
      Inc(aIndex);
    end;
    raise Exception.Create('Error: Unable to locate the end of $IFDEF or $IFNDEF directive.');
  end;

  procedure UndefineSymbol(aName : string);
  begin
    SymbolEntry := FindSymbolEntry(aName);
    if Assigned(SymbolEntry) then begin
      FItems.Remove(SymbolEntry);
      SymbolEntry.Free;
    end;
  end;

begin
  repeat
    { Check if end of file }
    Inc(aIndex);

    repeat
      if (Token[aIndex].Token = ttEof) or (aIndex >= (FWParser.Count - 1)) then begin
        if FWParserStack.Count > 0 then
          FWParserStack.Pop(FWParser, aIndex, FFileName);
      end;


      bFinish := True;
      if (Token[aIndex].Token = ttComment) and (Length(Token[aIndex].Text) > 1) and
         (Pos('$', Token[aIndex].Text) = 1)
      then begin
        {Symbol found}
        S := Copy(Token[aIndex].Text, 2, Length(Token[aIndex].Text) - 1);
        N := CutWord(S, ' ');
        V := Trim(S);
        if (UpperCase(N) = 'I') or (UpperCase(N) = 'INCLUDE') then
          IncludeFile(V, aIndex)
        else
        if UpperCase(N) = 'DEFINE' then AddSymbolEntry(V, '') else
        if UpperCase(N) = 'UNDEF' then UndefineSymbol(N) else
        if UpperCase(N) = 'IFDEF' then begin
          if Assigned(FindSymbolEntry(V)) then Break;
          StepUntilCommentToken(['$ELSE', '$ENDIF']);
          bFinish := False;
        end
        else
        if UpperCase(N) = 'IFNDEF' then begin
          if not Assigned(FindSymbolEntry(V)) then Break;
          StepUntilCommentToken(['$ELSE', '$ENDIF']);
          bFinish := False;
        end
        else
        if UpperCase(N) = 'ELSE' then StepUntilCommentToken(['$ENDIF']) else
        if UpperCase(N) = 'IFOPT' then else ;
      end;
    until bFinish;


  until (aIndex >= 0) and
        ( (aIndex >= (FWParser.Count - 1) ) or
          (Token[aIndex].Token <> ttComment) );
end;

procedure TWDelphiParser.ExpectToken(aIndex: Integer;
  aTokenType: TTokenType; aText, aErrorCode: String);
var
  S, sMsg : String;
  i, j, k : Integer;
begin
  if not IsToken(aIndex, aTokenType, aText) then begin
    aErrorCode := '- Error ' + aErrorCode;
    FErrors.Add(Format(aErrorCode + ' detected in file %s [%d, %d]',
                [FFileName, Token[aIndex].Row, Token[aIndex].Column]));
    FErrors.Add('');
    FErrors.Add(Format('Expected ''%s'', but ''%s'' found in the following:',
                [aText, Token[aIndex].Text]));
    S := '';
    i := aIndex;
    j := Token[i].Row;
    while (i > 0) and ((j = Token[i].Row) or (Abs(aIndex - i) < 10)) do begin
      if Token[i].Token <> ttComment then begin
        if S <> '' then S := ' ' + S;
        S := Token[i].Text + S;
      end;
      Dec(i);
    end;
    S := S + '<< Error!';
    FErrors.Add(S);
    FErrors.Add('');
    raise Exception.Create('The rest of the code ignored.');
  end;
end;

procedure TWDelphiParser.ExpectTokenBooleanValue(aIndex: Integer);
var
  S, sMsg : String;
  i, j, k : Integer;
begin
  if not (IsToken(aIndex, ttIdentifier, 'true') or
    IsToken(aIndex, ttIdentifier, 'false'))
  then begin
    (* If the value is not True or False, it can be a boolean constant declared
       somewhere. It's not actually error. So, just ignore it.
    FErrors.Add(Format('- Error 0FC4BCD8 detected in file %s [%d, %d]',
                [FFileName, Token[aIndex].Row, Token[aIndex].Column]));
    FErrors.Add('');
    FErrors.Add(Format('Expected Boolean, but ''%s'' found in the following:',
                [Token[aIndex].Text]));
    S := '';
    i := aIndex;
    j := Token[i].Row;
    while (i > 0) and ((j = Token[i].Row) or (Abs(aIndex - i) < 10)) do begin
      if Token[i].Token <> ttComment then begin
        if S <> '' then S := ' ' + S;
        S := Token[i].Text + S;
      end;
      Dec(i);
    end;
    S := S + '<< Error!';
    FErrors.Add(S);
    FErrors.Add('');
    raise Exception.Create('The rest of the code ignored.'); *)
  end;
end;

function TWDelphiParser.IsCommentTag(var aText : String; aTags : TStringList) : boolean;
var
  i : Integer;
begin
  Result := False;
  with aTags do
    if Count > 0 then
      for i := 0 to Count - 1 do
        if (Trim(Strings[i]) <> '') and
           { If aText begings from one of CommentTags words, accept it }
           (Pos(UpperCase(Strings[i]), UpperCase(aText)) = 1)
        then begin
          Result := True;
          aText := StringReplace(aText, Strings[i], '', []);
          Break;
        end;
end;

function TWDelphiParser.AcceptComment(var aText : String) : boolean;
var
  i : Integer;
begin
  { If CommentTag is empty, accept comment }
  Result := Trim(CommentTags.Text) = '';
  if not Result then
    with CommentTags do
      if Count > 0 then
        for i := 0 to Count - 1 do
          if (Trim(Strings[i]) <> '') and
             { If aText begings from one of CommentTags words, accept it }
             (Pos(UpperCase(Strings[i]), UpperCase(aText)) = 1)
          then begin
            Result := True;
            aText := StringReplace(aText, Strings[i], '', []);
            Break;
          end;
end;

function TWDelphiParser.IsCommentNewLineTag(var aText : String) : boolean;
var
  i : Integer;
begin
  Result := False;
  with CommentNewLineTags do
    if Count > 0 then
      for i := 0 to Count - 1 do
        if (Trim(Strings[i]) <> '') and
           { If aText ends in one of CommentTags words, accept it }
           (CompareText(Strings[i],
                        Copy(aText, Length(aText) - Length(Strings[i]) + 1,
                             Length(Strings[i]))) = 0)
        then begin
          Result := True;
          aText := StringReplace(aText, Strings[i], '', []);
          Break;
        end;
end;

procedure TWDelphiParser.AddComment(aText : String; var aComment : String; aAddBefore : boolean);
var
  i : Integer;
begin
  with TStringList.Create do
  try
    Text := aComment;
    //if Count = 0 then Add('');
    if aAddBefore then begin
      if (Count > 0) and (Strings[Count - 1] <> '') then
        Strings[0] := ' ' + Strings[0];
      if Trim(aText) <> '' then begin
        if Count > 0 then
          Strings[0] := Trim(aText) + Strings[0]
        else
          Add(Trim(aText));
      end
      else
        Insert(0, '');
    end
    else begin
      if (Count > 0) and (Strings[Count - 1] <> '') then
        Strings[Count - 1] := Strings[Count - 1] + ' ';
      if Trim(aText) <> '' then begin
        if Count > 0 then
          Strings[Count - 1] := Strings[Count - 1] + Trim(aText)
        else
          Add(Trim(aText));
      end
      else
        Add('');
    end;
    { Replace CommentNewLineTag if any }
    if CommentNewLineTags.Count > 0 then
      for i := 0 to CommentNewLineTags.Count - 1 do
        if Trim(CommentNewLineTags.Strings[i]) <> '' then
          Text := StringReplace(Text, CommentNewLineTags.Strings[i], #13, [rfReplaceAll]);
    if Count > 0 then
      for i := 0 to Count - 1 do
        Strings[i] := Trim(Strings[i]);
  finally
    aComment := Text;
    Free;
  end;
end;

procedure TWDelphiParser.LookBackwardForDescription(aIndex : Integer;
      var aSummary : String; var aDescription : String);
var
  CurrentSubType : TTokenSubType;
begin
  if not (poAcceptComments in Options) then Exit;
  if (aIndex <= 0) or (aIndex > FWParser.Count) then Exit;
  CurrentSubType := tsNone;
  Dec(aIndex);