uwdelphiparser.pas

来自「Delphi脚本控件」· PAS 代码 · 共 1,750 行 · 第 1/5 页

  while (aIndex >= 0) and (Token[aIndex].Token = ttComment) do begin
    if (aIndex > 0) and (Token[aIndex - 1].Token <> ttComment) and
       (Token[aIndex].Row = Token[aIndex - 1].Row)
    then Break;
    if (Pos('$', Token[aIndex].Text) <> 1) and
       (((Token[aIndex].SubType = tsCommentLine) and (poAcceptCommentLine in Options)) or
        ((Token[aIndex].SubType = tsComment1Block) and (poAcceptComment1Block in Options)) or
        ((Token[aIndex].SubType = tsComment2Block) and (poAcceptComment2Block in Options))) and
       ((CurrentSubType = tsNone) or (CurrentSubType = Token[aIndex].SubType))
    then begin
      CurrentSubType := Token[aIndex].SubType;
      if AcceptComment(Token[aIndex].Text) then begin
        if IsCommentTag(Token[aIndex].Text, CommentSummaryTags) then
          AddComment(Token[aIndex].Text, aSummary, True)
        else
        if IsCommentTag(Token[aIndex].Text, CommentDescriptionTags) then
          AddComment(Token[aIndex].Text, aDescription, True)
        else
          AddComment(Token[aIndex].Text, aDescription, True);
      end;
    end;
    Dec(aIndex);
  end;
end;

procedure TWDelphiParser.LookForwardForDescription(aIndex: Integer;
  var aSummary : String; var aDescription: String);
var
  iRow, iPrevCommentCol : Integer;
begin
  if not (poAcceptComments in Options) or (aIndex < 0) or
    (aIndex >= (FWParser.Count - 1))
  then Exit;

  iPrevCommentCol := -1;
  iRow := Token[aIndex].Row;
  Inc(aIndex);
  while (aIndex < (FWParser.Count - 1)) and (Token[aIndex].Token = ttComment) do begin
    if (Pos('$', Token[aIndex].Text) <> 1) and
       ((Token[aIndex].Row = iRow) or (Token[aIndex].Column = iPrevCommentCol)) and
       (((Token[aIndex].SubType = tsCommentLine) and (poAcceptCommentLine in Options)) or
        ((Token[aIndex].SubType = tsComment1Block) and (poAcceptComment1Block in Options)) or
        ((Token[aIndex].SubType = tsComment2Block) and (poAcceptComment2Block in Options)))
    then begin
      if AcceptComment(Token[aIndex].Text) then begin
        if IsCommentTag(Token[aIndex].Text, CommentSummaryTags) then
          AddComment(Token[aIndex].Text, aSummary, False)
        else
        if IsCommentTag(Token[aIndex].Text, CommentDescriptionTags) then
          AddComment(Token[aIndex].Text, aDescription, False)
        else
          AddComment(Token[aIndex].Text, aSummary, False);
      end;
      iPrevCommentCol := Token[aIndex].Column;
    end else Break;
    Inc(aIndex);
  end;
end;

procedure TWDelphiParser.WParserTokenReadUnit(Sender: TObject;
  Token: TToken; var AddToList, Stop: Boolean);
begin
  AddToList := True;
  Stop := IsToken(Token, ttKeyword, 'implementation');
  Application.ProcessMessages;
end;

procedure TWDelphiParser.ParseClassEntry(aClassEntry: TEntry;
  var aIndex: Integer);
var
  i : Integer;
  VisibilityArea : TVisibilityArea;
  slName : TStringList;
  sType, S1, S2 : String;
  iDeclarationBeginIndex  : Integer;
  ClassFunctionEntry : TClassFunctionEntry;
  ClassProcedureEntry : TClassProcedureEntry;
  ClassPropertyEntry : TClassPropertyEntry;
  ClassVarEntry : TClassVarEntry;
  bAddEntry, bIsClassMethod : boolean;
  bpDeclarationBegin : TWParserBreakPoint;
begin
  VisibilityArea := vaPublic;
  {type NewType = class(ParenType) <...>}
  try
    slName := TStringList.Create;
    bIsClassMethod := False;
    while not IsToken(aIndex, ttKeyword, 'end') do begin
      slName.Clear;
      if IsToken(aIndex, ttKeyword, 'protected') then begin
       {type NewType = class(ParenType) <protected>}
        VisibilityArea := vaProtected;
        StepNextToken(aIndex);
      end
      else
      if IsToken(aIndex, ttKeyword, 'private') then begin
       {type NewType = class(ParenType) <private>}
        VisibilityArea := vaPrivate;
        StepNextToken(aIndex);
      end
      else
      if IsToken(aIndex, ttKeyword, 'public') then begin
       {type NewType = class(ParenType) <public>}
        VisibilityArea := vaPublic;
        StepNextToken(aIndex);
      end
      else
      if IsToken(aIndex, ttKeyword, 'published') then begin
       {type NewType = class(ParenType) <published>}
        VisibilityArea := vaPublished;
        StepNextToken(aIndex);
      end
      else
      begin
        if IsToken(aIndex, ttKeyword, 'constructor') or
           IsToken(aIndex, ttKeyword, 'destructor') or
           IsToken(aIndex, ttKeyword, 'procedure') or
           IsToken(aIndex, ttKeyword, 'function') or
           IsToken(aIndex, ttKeyword, 'class')
        then begin
          if IsToken(aIndex, ttKeyword, 'class') then begin
            bIsClassMethod := True;
            StepNextToken(aIndex);
          end;
          {type NewType = class(ParenType) protected/private/public/published <...>}
          if IsToken(aIndex, ttKeyword, 'constructor') or
             IsToken(aIndex, ttKeyword, 'destructor') or
             IsToken(aIndex, ttKeyword, 'procedure')
          then
          try
            ClassProcedureEntry := TClassProcedureEntry.Create('', aClassEntry, Self);
            ClassProcedureEntry.VisibilityArea := VisibilityArea;
            ClassProcedureEntry.IsClassMethod := bIsClassMethod;

            iDeclarationBeginIndex := aIndex;
            with bpDeclarationBegin do begin Index := aIndex; Parser := FWParser; end;
            StepNextToken(aIndex);
            {type NewType = class(ParenType) [protected/private/public/published]
                  constructor/destructor/procedure <...>}
            ClassProcedureEntry.Name := FirstCapitalLetter(Token[aIndex].Text);
            StepNextToken(aIndex);

            if IsToken(aIndex, ttSpecialChar, '.') then begin
              StepNextToken(aIndex);
              ClassProcedureEntry.ParentObjectName := ClassProcedureEntry.Name;
              ClassProcedureEntry.ParentMethodName := FirstCapitalLetter(Token[aIndex].Text);
              StepNextToken(aIndex);
              ExpectToken(aIndex, ttSpecialChar, '=', '1F9F6110');
              StepNextToken(aIndex);
              ClassProcedureEntry.Name := FirstCapitalLetter(Token[aIndex].Text);
              StepNextToken(aIndex);
              {type NewType = class(ParenType) [protected/private/public/published]
                  procedure ParentObjectName.ParentMethodName = Name <...>}
            end;

            if IsToken(aIndex, ttSpecialChar, '(') then begin
              {type NewType = class(ParenType) [protected/private/public/published]
                    constructor/destructor/procedure Name <(>}
              aIndex := LocatePairBracket(aIndex);
              {type NewType = class(ParenType) [protected/private/public/published]
                    constructor/destructor/procedure Name (<)>}
              StepNextToken(aIndex);
            end;
            CheckForPlatformDirective(aIndex, ClassProcedureEntry);
            ExpectToken(aIndex, ttSpecialChar, ';', 'BA32ECDE');
            {type NewType = class(ParenType) [protected/private/public/published]
                  constructor/destructor/procedure Name ()<;>}

            ClassProcedureEntry.RoutineDirectives := [];
            ParseRoutineDirectives(aIndex, ClassProcedureEntry.RoutineDirectives,
                                   ClassProcedureEntry.MessageHandler,
                                   ClassProcedureEntry.HintDirectives);

            EndOfDeclaration(ClassProcedureEntry, bpDeclarationBegin,
                           WParserBreakpoint(aIndex, FWParser));
            {ClassProcedureEntry.Declaration := GetSourceString(iDeclarationBeginIndex, aIndex);
            LookBackwardForDescription(iDeclarationBeginIndex,
              ClassProcedureEntry.Summary, ClassProcedureEntry.Description);
            LookForwardForDescription(aIndex, ClassProcedureEntry.Summary,
              ClassProcedureEntry.Description);}

            StepNextToken(aIndex);

            //bAddEntry := True;
            bAddEntry := (VisibilityArea in FMemberVisibility);
            if bAddEntry then begin
              if Assigned(FOnClassProcedureEntry) then
                OnClassProcedureEntry(ClassProcedureEntry, bAddEntry);
              if Assigned(FOnProgress) then
                OnProgress(FStopAnalyze);  if FStopAnalyze then Abort;
            end;
            if not bAddEntry then ClassProcedureEntry.Free else FItems.Add(ClassProcedureEntry);
          except
            ClassProcedureEntry.Free;
            raise
          end
          else
          if IsToken(aIndex, ttKeyword, 'function') then
          try
            ClassFunctionEntry := TClassFunctionEntry.Create('', aClassEntry, Self);
            ClassFunctionEntry.VisibilityArea := VisibilityArea;
            ClassFunctionEntry.IsClassMethod := bIsClassMethod;

            iDeclarationBeginIndex := aIndex; { todo }
            with bpDeclarationBegin do begin Index := aIndex; Parser := FWParser; end;

            StepNextToken(aIndex);
            {type NewType = class(ParenType) [protected/private/public/published]
                  function <...>}
            ClassFunctionEntry.Name := FirstCapitalLetter(Token[aIndex].Text);
            StepNextToken(aIndex);

            if IsToken(aIndex, ttSpecialChar, '.') then begin
              StepNextToken(aIndex);
              ClassProcedureEntry.ParentObjectName := ClassProcedureEntry.Name;
              ClassProcedureEntry.ParentMethodName := FirstCapitalLetter(Token[aIndex].Text);
              StepNextToken(aIndex);
              ExpectToken(aIndex, ttSpecialChar, '=', '1F9F6110');
              StepNextToken(aIndex);
              ClassProcedureEntry.Name := FirstCapitalLetter(Token[aIndex].Text);
              StepNextToken(aIndex);
              {type NewType = class(ParenType) [protected/private/public/published]
                  function ParentObjectName.ParentMethodName = Name <...>}
            end
            else begin
              if IsToken(aIndex, ttSpecialChar, '(') then begin
                {type NewType = class(ParenType) [protected/private/public/published]
                      function Name <(>}
                aIndex := LocatePairBracket(aIndex);
                {type NewType = class(ParenType) [protected/private/public/published]
                      function Name (...<)>}
                StepNextToken(aIndex);
              end;
              ExpectToken(aIndex, ttSpecialChar, ':', 'C6708B9E');
              StepNextToken(aIndex);
              ClassFunctionEntry.ResultType := Token[aIndex].Text;
              StepNextToken(aIndex);
            end;

            CheckForPlatformDirective(aIndex, ClassFunctionEntry);
            ExpectToken(aIndex, ttSpecialChar, ';', '84619BF2');

            ClassFunctionEntry.RoutineDirectives := [];
            ParseRoutineDirectives(aIndex, ClassFunctionEntry.RoutineDirectives,
                                   ClassFunctionEntry.MessageHandler,
                                   ClassFunctionEntry.HintDirectives);

            EndOfDeclaration(ClassFunctionEntry, bpDeclarationBegin,
                           WParserBreakpoint(aIndex, FWParser));
            {ClassFunctionEntry.Declaration := GetSourceString(iDeclarationBeginIndex, aIndex);
            LookBackwardForDescription(iDeclarationBeginIndex,
              ClassFunctionEntry.Summary, ClassFunctionEntry.Description);
            LookForwardForDescription(aIndex, ClassFunctionEntry.Summary,
              ClassFunctionEntry.Description);}
            StepNextToken(aIndex);
            //bAddEntry := True;
            bAddEntry := (VisibilityArea in FMemberVisibility);
            if bAddEntry then begin
              if Assigned(FOnClassFunctionEntry) then
                OnClassFunctionEntry(ClassFunctionEntry, bAddEntry);
              if Assigned(FOnProgress) then
                OnProgress(FStopAnalyze);  if FStopAnalyze then Abort;
            end;
            if not bAddEntry then ClassFunctionEntry.Free else FItems.Add(ClassFunctionEntry);
          except
            ClassFunctionEntry.Free;
            raise
          end;
        end
        else
        if IsToken(aIndex, ttKeyword, 'property') then
        try
          ClassPropertyEntry := TClassPropertyEntry.Create('', aClassEntry, Self);
          ClassPropertyEntry.VisibilityArea := VisibilityArea;
          ClassPropertyEntry.StorageSpecifiers := [];

          ClassPropertyEntry.ArrayIsDefaultProperty := False;
          iDeclarationBeginIndex := aIndex;
          with bpDeclarationBegin do begin Index := aIndex; Parser := FWParser; end;

          StepNextToken(aIndex);
          ClassPropertyEntry.Name := FirstCapitalLetter(Token[aIndex].Text);

          StepNextToken(aIndex);
          {type NewType = class(ParenType) [protected/private/public/published]
                property Name <...>}
          if IsToken(aIndex, ttSpecialChar, '[') then begin
            {type NewType = class(ParenType) [protected/private/public/published]
                  property Name <[>}
            aIndex := FindToken(']', ttSpecialChar, aIndex);
            if aIndex < 0 then {Error!!!};
            StepNextToken(aIndex);
            {type NewType = class(ParenType) [protected/private/public/published]
                  property Name [...] <...>}
          end;
          if IsToken(aIndex, ttSpecialChar, ';') then begin
            EndOfDeclaration(ClassPropertyEntry, bpDeclarationBegin,
                           WParserBreakpoint(aIndex, FWParser));
            StepNextToken(aIndex);
            {type NewType = class(ParenType) [protected/private/public/published]
                  property Name [...]; <...>}
          end
          else begin

            if IsToken(aIndex, ttSpecialChar, ':') then begin
              StepNextToken(aIndex);
              ClassPropertyEntry.TypeName := FirstCapitalLetter(Token[aIndex].Text);
              StepNextToken(aIndex);
            end;

            {type NewType = class(ParenType) [protected/private/public/published]
                  property Name [...] : PropertyType <...>}

            while IsToken(aIndex, ttKeyword, 'read') or IsToken(aIndex, ttKeyword, 'write') or
                  IsToken(aIndex, ttIdentifier, 'index') or IsToken(aIndex, ttKeyword, 'implements')
            do begin
              if IsToken(aIndex, ttKeyword, 'read') then begin
                StepNextToken(aIndex);
                ClassPropertyEntry.PropertyReadProcName := FirstCapitalLetter(ReadPropertyProcName(aIndex));
                {type NewType = class(ParenType) [protected/private/public/published]
                      property Name [...] : PropertyType read ProcName <...>}
              end
              else
              if IsToken(aIndex, ttKeyword, 'write') then begin
                StepNextToken(aIndex);
                ClassPropertyEntry.PropertyWriteProcName := FirstCapitalLetter(ReadPropertyProcName(aIndex));
                {type NewType = class(ParenType) [protected/private/public/published]
                      property Name [...] : PropertyType write ProcName <...>}
              end
              else
              if IsToken(aIndex, ttIdentifier, 'index') then begin
                StepNextToken(aIndex);
                ClassPropertyEntry.PropertyIndex := Token[aIndex].Text;
                StepNextToken(aIndex);
                i := FindToken('read', ttKeyword, aIndex);
                if i < 0 then
                  i := FindToken('write', ttKeyword, aIndex);
                if i < 0 then
                  raise Exception.Create('Error DC1DD985: Unable to locate the end of Index declaration.');

                ClassPropertyEntry.PropertyIndex := GetSourceString(aIndex, i - 1);
                aIndex := i;
                {type NewType = class(ParenType) [protected/private/public/published]
                      property Name [...] : PropertyType Index IndexValue <...>}
              end
              else
              if IsToken(aIndex, ttKeyword, 'implements') then begin
                repeat
                  StepNextToken(aIndex);
                  ClassPropert