implemented "class of" for find declaration

git-svn-id: trunk@4435 -

components/codetools/codetoolsstrconsts.pas

@@ -102,6 +102,7 @@ ResourceString
      'inherited keyword only allowed in methods';
   ctsCircleInDefinitions = 'circle in definitions';
   ctsForwardClassDefinitionNotResolved = 'Forward class definition not resolved: %s';
+  ctsClassOfDefinitionNotResolved = '"class of" definition not resolved: %s';
   ctsTypeIdentifier = 'type identifier';
   ctsAncestorIsNotProperty = 'ancestor of untyped property is not a property';
   ctsBaseTypeOfNotFound = 'base type of "%s" not found';

components/codetools/finddeclarationtool.pas

@@ -2324,6 +2324,12 @@ function TFindDeclarationTool.FindBaseTypeOfNode(Params: TFindDeclarationParams;
     RaiseExceptionFmt(ctsBaseTypeOfNotFound,[GetIdentifier(Params.Identifier)]);
   end;
   
+  procedure RaiseClassOfWithoutIdentifier;
+  begin
+    RaiseExceptionFmt(ctsBaseTypeOfNotFound+' ("class of")',
+                      [GetIdentifier(Params.Identifier)]);
+  end;
+  
 var
   OldInput: TFindDeclarationInput;
   ClassIdentNode, DummyNode: TCodeTreeNode;
@@ -2338,6 +2344,14 @@ var
             ClassIdentNode.EndPos-ClassIdentNode.StartPos)]);
   end;
   
+  procedure RaiseClassOfNotResolved;
+  begin
+    MoveCursorToNodeStart(ClassIdentNode);
+    RaiseExceptionFmt(ctsClassOfDefinitionNotResolved,
+        [copy(Src,ClassIdentNode.StartPos,
+            ClassIdentNode.EndPos-ClassIdentNode.StartPos)]);
+  end;
+
 begin
   Result.Node:=Node;
   Result.Tool:=Self;
@@ -2405,6 +2419,38 @@ begin
         Params.Load(OldInput);
         exit;
       end else
+      if (Result.Node.Desc=ctnClassOfType) then
+      begin
+        // this is a 'class of' type
+        // -> search the real class
+        {$IFDEF ShowTriedBaseContexts}
+        writeln('[TFindDeclarationTool.FindBaseTypeOfNode] "Class Of"');
+        {$ENDIF}
+
+        // ToDo: check for circles in ancestor chain
+
+        ClassIdentNode:=Result.Node.FirstChild;
+        if (ClassIdentNode=nil) or (not (ClassIdentNode.Desc=ctnIdentifier))
+        then begin
+          MoveCursorToCleanPos(Result.Node.StartPos);
+          RaiseClassOfWithoutIdentifier;
+        end;
+        Params.Save(OldInput);
+        Params.SetIdentifier(Self,@Src[ClassIdentNode.StartPos],
+                             @CheckSrcIdentifier);
+        Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
+                       fdfIgnoreCurContextNode]
+                      +(fdfGlobals*Params.Flags);
+        Params.ContextNode:=Result.Node.Parent;
+        FindIdentifierInContext(Params);
+        if (Params.NewNode.Desc<>ctnTypeDefinition) then begin
+          MoveCursorToCleanPos(Result.Node.StartPos);
+          RaiseClassOfNotResolved;
+        end;
+        Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode);
+        Params.Load(OldInput);
+        exit;
+      end else
       if (Result.Node.Desc=ctnIdentifier) then begin
         // this type is just an alias for another type
         // -> search the basic type

components/codetools/pascalparsertool.pas

@@ -2551,18 +2551,25 @@ begin
   // find end of class
   ReadNextAtom;
   if UpAtomIs('OF') then begin
+    if ChildCreated then CurNode.Desc:=ctnClassOfType;
     ReadNextAtom;
     AtomIsIdentifier(true);
+    if ChildCreated then begin
+      CreateChildNode;
+      CurNode.Desc:=ctnIdentifier;
+      CurNode.EndPos:=CurPos.EndPos;
+      EndChildNode;
+    end;
     ReadNextAtom;
     if CurPos.Flag<>cafSemicolon then
       RaiseCharExpectedButAtomFound(';');
-    if ChildCreated then CurNode.Desc:=ctnClassOfType;
   end else if (CurPos.Flag=cafRoundBracketOpen) then begin
     // read inheritage brackets
     ReadTilBracketClose(true);
     ReadNextAtom;
   end;
-  CurNode.SubDesc:=ctnsNeedJITParsing; // will not create sub nodes now
+  if ChildCreated and (CurNode.Desc=ctnClass) then
+    CurNode.SubDesc:=ctnsNeedJITParsing; // will not create sub nodes now
   if CurPos.Flag=cafSemicolon then begin
     if ChildCreated and (CurNode.Desc=ctnClass) then begin
       // forward class definition found