MG: find declaration of class ancestor, result type, default property, array, indexed pointer

git-svn-id: trunk@602 -

components/codetools/codetree.pas

@@ -52,55 +52,56 @@ const
   // CodeTreeNodeDescriptors
   ctnNone            = 0;
 
-  ctnClass           = 1;
+  ctnProgram         = 1;
-  ctnClassPublished  = 2;
+  ctnPackage         = 2;
-  ctnClassPrivate    = 3;
+  ctnLibrary         = 3;
-  ctnClassProtected  = 4;
+  ctnUnit            = 4;
-  ctnClassPublic     = 5;
+  ctnInterface       = 5;
+  ctnImplementation  = 6;
+  ctnInitialization  = 7;
+  ctnFinalization    = 8;
 
-  ctnProcedure       = 10;
+  ctnTypeSection     = 10;
-  ctnProcedureHead   = 11;
+  ctnVarSection      = 11;
-  ctnParameterList   = 12;
+  ctnConstSection    = 12;
+  ctnResStrSection   = 13;
+  ctnUsesSection     = 14;
 
-  ctnBeginBlock      = 20;
+  ctnTypeDefinition  = 20;
-  ctnAsmBlock        = 21;
+  ctnVarDefinition   = 21;
+  ctnConstDefinition = 22;
 
-  ctnProgram         = 30;
+  ctnClass           = 30;
-  ctnPackage         = 31;
+  ctnClassPublished  = 31;
-  ctnLibrary         = 32;
+  ctnClassPrivate    = 32;
-  ctnUnit            = 33;
+  ctnClassProtected  = 33;
-  ctnInterface       = 34;
+  ctnClassPublic     = 34;
-  ctnImplementation  = 35;
-  ctnInitialization  = 36;
-  ctnFinalization    = 37;
 
-  ctnTypeSection     = 40;
+  ctnProperty        = 40;
-  ctnVarSection      = 41;
-  ctnConstSection    = 42;
-  ctnResStrSection   = 43;
-  ctnUsesSection     = 44;
-
-  ctnTypeDefinition  = 50;
-  ctnVarDefinition   = 51;
-  ctnConstDefinition = 52;
-
-  ctnProperty        = 60;
   
-  ctnIdentifier      = 70;
+  ctnProcedure       = 50;
-  ctnArrayType       = 71;
+  ctnProcedureHead   = 51;
-  ctnRecordType      = 72;
+  ctnParameterList   = 52;
-  ctnRecordCase      = 73;
+
-  ctnRecordVariant   = 74;
+  ctnIdentifier      = 60;
-  ctnProcedureType   = 75;
+  ctnArrayType       = 61;
-  ctnSetType         = 76;
+  ctnOfConstType     = 62;
-  ctnRangeType       = 77;
+  ctnRecordType      = 63;
-  ctnEnumType        = 78;
+  ctnRecordCase      = 64;
-  ctnLabelType       = 79;
+  ctnRecordVariant   = 65;
-  ctnTypeType        = 80;
+  ctnProcedureType   = 66;
-  ctnFileType        = 81;
+  ctnSetType         = 67;
-  ctnPointerType     = 82;
+  ctnRangeType       = 68;
-  ctnClassOfType     = 83;
+  ctnEnumType        = 69;
+  ctnLabelType       = 70;
+  ctnTypeType        = 71;
+  ctnFileType        = 72;
+  ctnPointerType     = 73;
+  ctnClassOfType     = 74;
   
+  ctnBeginBlock      = 80;
+  ctnAsmBlock        = 81;
+
   ctnWithVariable    = 90;
   ctnWithStatement   = 91;
 
@@ -123,8 +124,9 @@ const
 
 
   // CodeTreeNodeSubDescriptors
-  ctnsNone               = 0;
+  ctnsNone                 = 0;
-  ctnsForwardDeclaration = 1;
+  ctnsForwardDeclaration   = 1;
+  ctnsProcHeadNodesCreated = 2;
   
 type
   TCodeTreeNode = class
@@ -548,7 +550,7 @@ begin
   FCount:=0;
   FAllocatedNodes:=0;
   FFreedNodes:=0;
-  FMinFree:=10000;
+  FMinFree:=100000;
   FMaxFreeRatio:=8; // 1:1
 end;
 
@@ -626,7 +628,7 @@ begin
   FFirstFree:=nil;
   FFreeCount:=0;
   FCount:=0;
-  FMinFree:=10000;
+  FMinFree:=20000;
   FMaxFreeRatio:=8; // 1:1
 end;
 

components/codetools/customcodetool.pas

@@ -224,6 +224,10 @@ begin
     // CodeTreeNodeSubDescriptors
     ctnsForwardDeclaration : Result:='Forward';
     end;
+  ctnProcedureHead:
+    case SubDesc of
+    ctnsProcHeadNodesCreated: Result:='Nodes Created';
+    end;
   end;
 end;
 

components/codetools/finddeclarationtool.pas

@@ -596,13 +596,21 @@ if (ContextNode.Desc=ctnClass) then
         ctnInterface, ctnImplementation,
         ctnClassPublic, ctnClassPrivate, ctnClassProtected, ctnClassPublished,
         ctnClass,
-        ctnRecordType, ctnRecordCase, ctnRecordVariant:
+        ctnRecordType, ctnRecordCase, ctnRecordVariant,
+        ctnParameterList:
           if (ContextNode.LastChild<>nil) then begin
             if not (fdfSearchForward in Params.Flags) then
               ContextNode:=ContextNode.LastChild
             else
               ContextNode:=ContextNode.FirstChild;
           end;
+          
+        ctnProcedureHead:
+          begin
+            BuildSubTreeForProcHead(ContextNode);
+            if ContextNode.FirstChild<>nil then
+              ContextNode:=ContextNode.FirstChild;
+          end;
 
         ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition, ctnEnumType:
           begin
@@ -645,15 +653,21 @@ writeln('  Definition Identifier found=',copy(Src,ContextNode.StartPos,Params.Id
 
         ctnProperty:
           begin
-            MoveCursorToNodeStart(ContextNode);
+            if (Src[Params.IdentifierStartPos]<>'[') then begin
-            ReadNextAtom; // read keyword 'property'
+              MoveCursorToNodeStart(ContextNode);
-            ReadNextAtom; // read name
+              ReadNextAtom; // read keyword 'property'
-            if CompareSrcIdentifiers(Params.IdentifierStartPos,CurPos.StartPos)
+              ReadNextAtom; // read name
-            then begin
+              if CompareSrcIdentifiers(Params.IdentifierStartPos,CurPos.StartPos)
-              // identifier found
+              then begin
-              Result:=true;
+                // identifier found
-              Params.SetResult(Self,ContextNode,CurPos.StartPos);
+                Result:=true;
-              exit;
+                Params.SetResult(Self,ContextNode,CurPos.StartPos);
+                exit;
+              end;
+            end else begin
+              // the default property is searched
+              Result:=PropertyIsDefault(ContextNode);
+              if Result then exit;
             end;
           end;
 
@@ -752,7 +766,8 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in Parent  Con
             ctnTypeSection, ctnVarSection, ctnConstSection, ctnResStrSection,
             ctnInterface, ctnImplementation,
             ctnClassPublished,ctnClassPublic,ctnClassProtected, ctnClassPrivate,
-            ctnRecordCase, ctnRecordVariant:
+            ctnRecordCase, ctnRecordVariant,
+            ctnProcedureHead, ctnParameterList:
               // these codetreenodes build a parent-child-relationship, but
               // for pascal it is only a range, hence after searching in the
               // childs of the last node, it must be searched next in the childs
@@ -900,12 +915,17 @@ begin
   ReadPriorAtom;
   CurAtom:=CurPos;
   CurAtomType:=GetCurrentAtomType;
-  if CurAtomType=atNone then begin
+  if CurAtomType in [atNone,atSpace,atINHERITED,atRoundBracketOpen,
+    atEdgedBracketOpen,atRoundBracketClose] then begin
     // no special context found -> the context node is the deepest node at
     // cursor, and this should already be in Params.ContextNode
     Result:=Params.ContextNode;
     exit;
   end;
+  if (CurAtomType in [atRoundBracketClose,atEdgedBracketClose]) then begin
+    ReadBackTilBracketClose(true);
+    CurAtom.StartPos:=CurPos.StartPos;
+  end;
   Result:=FindContextNodeAtCursor(Params);
   if Result=nil then exit;
   
@@ -934,20 +954,42 @@ writeln('');
         MoveCursorToCleanPos(NextAtom.StartPos);
         RaiseException('syntax error: "'+GetAtom+'" found');
       end;
-      if (Result=Params.ContextNode)
+      if (Result=Params.ContextNode) then begin
-      and (CompareSrcIdentifier(CurAtom.StartPos,'SELF')) then begin
+        if CompareSrcIdentifier(CurAtom.StartPos,'SELF') then begin
-        // SELF in a method is the object itself
+          // SELF in a method is the object itself
-        // -> check if in a proc
+          // -> check if in a proc
-        ProcNode:=Params.ContextNode;
+          ProcNode:=Params.ContextNode;
-        while (ProcNode<>nil) do begin
+          while (ProcNode<>nil) do begin
-          if (ProcNode.Desc=ctnProcedure) then begin
+            if (ProcNode.Desc=ctnProcedure) then begin
-            // in a proc -> find the class context
+              // in a proc -> find the class context
-            if FindClassOfMethod(ProcNode,Params,true) then begin
+              if FindClassOfMethod(ProcNode,Params,true) then begin
-              Result:=Params.NewNode;
+                Result:=Params.NewNode;
-              exit;
+                exit;
+              end;
             end;
+            ProcNode:=ProcNode.Parent;
+          end;
+        end else if CompareSrcIdentifier(CurAtom.StartPos,'RESULT') then begin
+          // RESULT has a special meaning in a function
+          // -> check if in a function
+          ProcNode:=Params.ContextNode;
+          while (ProcNode<>nil) do begin
+            if (ProcNode.Desc=ctnProcedure) then begin
+              MoveCursorToNodeStart(ProcNode);
+              ReadNextAtom;
+              if UpAtomIs('CLASS') then ReadNextAtom;
+              if UpAtomIs('FUNCTION') then begin;
+                // in a function -> find the result type
+                BuildSubTreeForProcHead(ProcNode);
+                ProcNode:=ProcNode.FirstChild.FirstChild;
+                if Result.Desc=ctnParameterList then
+                  Result:=Result.NextBrother;
+                FindBaseTypeOfNode(Params,Result);
+                exit;
+              end;
+            end;
+            ProcNode:=ProcNode.Parent;
           end;
-          ProcNode:=ProcNode.Parent;
         end;
       end;
       // find identifier
@@ -970,6 +1012,7 @@ writeln('');
       finally
         Params.Load(OldInput);
       end;
+      Result:=FindBaseTypeOfNode(Params,Result);
     end;
     
   atPoint:
@@ -1013,17 +1056,56 @@ writeln('');
           MoveCursorToCleanPos(CurAtom.StartPos);
           RaiseException('illegal qualifier ^');
         end;
-        Result:=Result.FirstChild;
+        Result:=FindBaseTypeOfNode(Params,Result.FirstChild);
       end else if NodeHasParentOfType(Result,ctnPointerType) then begin
         // this is a pointer type definition
         // -> the default context is ok
       end;
     end;
 
+  atEdgedBracketClose:
+    begin
+      // for example:  a[]
+      //   this could be:
+      //     1. ranged array
+      //     2. dynamic array
+      //     3. indexed pointer
+      //     4. default property
+      if Result<>Params.ContextNode then begin
+        case Result.Desc of
+        
+        ctnArrayType:
+          // the array type is the last child node
+          Result:=FindBaseTypeOfNode(Params,Result.LastChild);
 
-  // ToDo: atINHERITED, atRoundBracketClose, atEdgedBracketClose
+        ctnPointerType:
+          // the pointer type is the only child node
+          Result:=FindBaseTypeOfNode(Params,Result.FirstChild);
+
+        ctnClass:
+          begin
+            Params.Save(OldInput);
+            Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound]
+                          +fdfGlobals*Params.Flags;
+            Params.IdentifierStartPos:=CurAtom.StartPos;
+            Params.IdentifierEndPos:=CurAtom.StartPos+1;
+            Params.ContextNode:=Result;
+            FindIdentifierInContext(Params);
+            Result:=FindBaseTypeOfNode(Params,Params.NewNode);
+            Params.Load(OldInput);
+          end;
+
+        else
+          MoveCursorToCleanPos(CurAtom.StartPos);
+          RaiseException('illegal qualifier');
+        end;
+      end;
+    end;
+
+  // ToDo: atINHERITED, atRoundBracketClose
 
   else
+    // expression start found
     begin
       if (not (NextAtomType in [atSpace,atIdentifier,atRoundBracketOpen,
         atEdgedBracketOpen])) then
@@ -1036,9 +1118,6 @@ writeln('');
     end;
   end;
   
-  // try to get the base type of the found context
-  Result:=FindBaseTypeOfNode(Params,Result);
-
 {$IFDEF CTDEBUG}
 write('[TFindDeclarationTool.FindContextNodeAtCursor] END ',
   Params.ContextNode.DescAsString,' CurAtom=',AtomTypeNames[CurAtomType],
@@ -1088,11 +1167,6 @@ begin
         Params.Load(OldInput);
       end;
     end else
-    if (Result.Desc=ctnTypeType) then begin
-      // a TypeType is for example 'MyInt = type integer;'
-      // the context is not the 'type' keyword, but the identifier after it.
-      Result:=Result.FirstChild;
-    end else
     if (Result.Desc=ctnIdentifier) then begin
       // this type is just an alias for another type
       // -> search the basic type
@@ -1113,6 +1187,30 @@ begin
       finally
         Params.Load(OldInput);
       end;
+    end else
+    if (Result.Desc=ctnProperty) then begin
+      // this is a property -> search the type definition of the property
+      ReadTilTypeOfProperty(Result);
+      Params.Save(OldInput);
+      try
+        Params.IdentifierStartPos:=CurPos.StartPos;
+        Params.IdentifierEndPos:=CurPos.EndPos;
+        Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound]
+                      +(fdfGlobals*Params.Flags);
+        Params.ContextNode:=Result.Parent;
+        FindIdentifierInContext(Params);
+        if Result.HasAsParent(Params.NewNode) then
+          break
+        else
+          Result:=Params.NewNode;
+      finally
+        Params.Load(OldInput);
+      end;
+    end else
+    if (Result.Desc=ctnTypeType) then begin
+      // a TypeType is for example 'MyInt = type integer;'
+      // the context is not the 'type' keyword, but the identifier after it.
+      Result:=Result.FirstChild;
     end else
       break;
   end;
@@ -1139,6 +1237,8 @@ var
   ClassContextNode: TCodeTreeNode;
 begin
   Result:=false;
+  // if proc is a method, search in class
+  // -> find class name
   MoveCursorToNodeStart(ProcContextNode);
   ReadNextAtom; // read keyword
   ReadNextAtom; // read classname

components/codetools/pascalparsertool.pas

@@ -76,7 +76,8 @@ type
       phpWithoutName, phpWithVarModifiers, phpWithParameterNames,
       phpWithDefaultValues, phpWithResultType, phpWithComments, phpInUpperCase,
       phpWithoutBrackets, phpIgnoreForwards, phpIgnoreProcsWithBody,
-      phpOnlyWithClassname, phpFindCleanPosition, phpWithoutParamList);
+      phpOnlyWithClassname, phpFindCleanPosition, phpWithoutParamList,
+      phpCreateNodes);
   TProcHeadAttributes = set of TProcHeadAttribute;
   
   TProcHeadExtractPos = (phepNone, phepStart, phepName, phepParamList);
@@ -143,7 +144,8 @@ type
     procedure BuildBlockStatementStartKeyWordFuncList; virtual;
     function UnexpectedKeyWord: boolean;
     // read functions
-    function ReadTilProcedureHeadEnd(IsMethod, IsFunction, IsType: boolean;
+    function ReadTilProcedureHeadEnd(IsMethod, IsFunction, IsType,
+        CreateNodes: boolean;
         var HasForwardModifier: boolean): boolean;
     function ReadConstant(ExceptionOnError, Extract: boolean;
         Attr: TProcHeadAttributes): boolean;
@@ -162,6 +164,7 @@ type
     function ReadWithStatement(ExceptionOnError,
         CreateNodes: boolean): boolean;
     procedure ReadVariableType;
+    procedure ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode);
   public
     CurSection: TCodeTreeNodeDesc;
 
@@ -176,6 +179,7 @@ type
         CursorPos: TCodeXYPosition; var CleanCursorPos: integer);
     procedure BuildSubTreeForClass(ClassNode: TCodeTreeNode); virtual;
     procedure BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode); virtual;
+    procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode); virtual;
     function DoAtom: boolean; override;
     function ExtractPropName(PropNode: TCodeTreeNode;
         InUpperCase: boolean): string;
@@ -208,6 +212,7 @@ type
     function GetSourceType: TCodeTreeNodeDesc;
     function NodeHasParentOfType(ANode: TCodeTreeNode;
         NodeDesc: TCodeTreeNodeDesc): boolean;
+    function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
     constructor Create;
     destructor Destroy; override;
   end;
@@ -851,7 +856,7 @@ begin
   IsFunction:=UpAtomIs('FUNCTION');
   ReadNextAtom;
   HasForwardModifier:=false;
-  ReadTilProcedureHeadEnd(true,IsFunction,true,HasForwardModifier);
+  ReadTilProcedureHeadEnd(true,IsFunction,true,false,HasForwardModifier);
   Result:=true;
 end;
 
@@ -930,7 +935,7 @@ begin
   CurNode.Desc:=ctnProcedureHead;
   // read rest
   ReadNextAtom;
-  ReadTilProcedureHeadEnd(true,IsFunction,false,HasForwardModifier);
+  ReadTilProcedureHeadEnd(true,IsFunction,false,false,HasForwardModifier);
   // close procedure header
   CurNode.EndPos:=CurPos.EndPos;
   EndChildNode;
@@ -943,6 +948,7 @@ end;
 function TPascalParserTool.ReadParamList(ExceptionOnError, Extract: boolean;
   Attr: TProcHeadAttributes): boolean;
 var CloseBracket: char;
+  Desc: TCodeTreeNodeDesc;
 begin
   Result:=false;
   if AtomIsChar('(') or AtomIsChar('[') then begin
@@ -950,6 +956,10 @@ begin
       CloseBracket:=')'
     else
       CloseBracket:=']';
+    if (phpCreateNodes in Attr) then begin
+      CreateChildNode;
+      CurNode.Desc:=ctnParameterList;
+    end;
     if not Extract then
       ReadNextAtom
     else
@@ -958,25 +968,37 @@ begin
     CloseBracket:=#0;
   repeat
     // read parameter prefix modifier
-    if (UpAtomIs('VAR')) or (UpAtomIs('CONST')) or (UpAtomIs('OUT')) then
+    if (UpAtomIs('VAR')) or (UpAtomIs('CONST')) or (UpAtomIs('OUT')) then begin
+      Desc:=ctnVarDefinition;
       if not Extract then
         ReadNextAtom
       else
         ExtractNextAtom(phpWithVarModifiers in Attr,Attr);
+    end else
+      Desc:=ctnVarDefinition;
     // read parameter name(s)
     repeat
-      AtomIsIdentifier(ExceptionOnError);
+      if not AtomIsIdentifier(ExceptionOnError) then exit;
+      if (phpCreateNodes in Attr) then begin
+        CreateChildNode;
+        CurNode.Desc:=Desc;
+      end;
       if not Extract then
         ReadNextAtom
       else
         ExtractNextAtom(phpWithParameterNames in Attr,Attr);
       if not AtomIsChar(',') then
         break
-      else
+      else begin
+        if (phpCreateNodes in Attr) then begin
+          CurNode.EndPos:=LastAtoms.GetValueAt(0).EndPos;
+          EndChildNode;
+        end;
         if not Extract then
           ReadNextAtom
         else
           ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
+      end;
     until false;
     // read type
     if (AtomIsChar(':')) then begin
@@ -995,6 +1017,10 @@ begin
           Extract and (phpWithDefaultValues in Attr),Attr);
       end;
     end;
+    if (phpCreateNodes in Attr) then begin
+      CurNode.EndPos:=CurPos.EndPos;
+      EndChildNode;
+    end;
     // read next parameter
     if (CurPos.StartPos>SrcLen) then
       if ExceptionOnError then
@@ -1018,6 +1044,10 @@ begin
         RaiseException(
           'syntax error: '+CloseBracket+' expected, but '+GetAtom+' found')
       else exit;
+    if (phpCreateNodes in Attr) then begin
+      CurNode.EndPos:=CurPos.EndPos;
+      EndChildNode;
+    end;
     if not Extract then
       ReadNextAtom
     else
@@ -1032,6 +1062,10 @@ begin
   Result:=false;
   if AtomIsWord then begin
     if UpAtomIs('ARRAY') then begin
+      if (phpCreateNodes in Attr) then begin
+        CreateChildNode;
+        CurNode.Desc:=ctnArrayType;
+      end;
       if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
       if not UpAtomIs('OF') then
         if ExceptionOnError then
@@ -1039,6 +1073,12 @@ begin
         else exit;
       ReadNextAtom;
       if UpAtomIs('CONST') then begin
+        if (phpCreateNodes in Attr) then begin
+          CreateChildNode;
+          CurNode.Desc:=ctnArrayType;
+          CurNode.EndPos:=CurPos.EndPos;
+          EndChildNode;
+        end;
         if not Extract then
           ReadNextAtom
         else
@@ -1048,6 +1088,12 @@ begin
       end;
     end;
     if not AtomIsIdentifier(ExceptionOnError) then exit;
+    if (phpCreateNodes in Attr) then begin
+      CreateChildNode;
+      CurNode.Desc:=ctnIdentifier;
+      CurNode.EndPos:=CurPos.EndPos;
+      EndChildNode;
+    end;
     if not Extract then
       ReadNextAtom
     else
@@ -1062,7 +1108,7 @@ begin
 end;
 
 function TPascalParserTool.ReadTilProcedureHeadEnd(
-  IsMethod, IsFunction, IsType: boolean;
+  IsMethod, IsFunction, IsType, CreateNodes: boolean;
   var HasForwardModifier: boolean): boolean;
 { parse parameter list, result type, of object, method specifiers
 
@@ -1087,23 +1133,30 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
    [alias: <string constant>]
 }
 var IsSpecifier: boolean;
+  Attr: TProcHeadAttributes;
 begin
 //writeln('[TPascalParserTool.ReadTilProcedureHeadEnd] ',
 //'Method=',IsMethod,', Function=',IsFunction,', Type=',IsType);
   Result:=true;
   HasForwardModifier:=false;
-  if AtomIsChar('(') then
+  if AtomIsChar('(') then begin
-    ReadParamList(true,false,[]);
+    Attr:=[];
+    if CreateNodes then
+      Include(Attr,phpCreateNodes);
+    ReadParamList(true,false,Attr);
+  end;
   if IsFunction then begin
     // read function result type
     if not AtomIsChar(':') then
       RaiseException('syntax error: : expected, but '+GetAtom+' found');
     ReadNextAtom;
-    if (CurPos.StartPos>SrcLen)
+    AtomIsIdentifier(true);
-    or (not (UpperSrc[CurPos.StartPos] in ['A'..'Z','_']))
+    if CreateNodes then begin
-    then
+      CreateChildNode;
-      RaiseException(
+      CurNode.Desc:=ctnIdentifier;
-        'syntax error: method result type expected but '+GetAtom+' found');
+      CurNode.EndPos:=CurPos.EndPos;
+      EndChildNode;
+    end;
     ReadNextAtom;
   end;
   if UpAtomIs('OF') then begin
@@ -1537,7 +1590,7 @@ begin
   end;
   // read rest of procedure head
   HasForwardModifier:=false;
-  ReadTilProcedureHeadEnd(false,IsFunction,false,HasForwardModifier);
+  ReadTilProcedureHeadEnd(false,IsFunction,false,false,HasForwardModifier);
   if ChildCreated then begin
     if HasForwardModifier then
       ProcNode.SubDesc:=ctnsForwardDeclaration;
@@ -3059,6 +3112,67 @@ begin
   end;
 end;
 
+procedure TPascalParserTool.ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode);
+begin
+  MoveCursorToNodeStart(PropertyNode);
+  ReadNextAtom; // read keyword 'property'
+  ReadNextAtom; // read property name
+  AtomIsIdentifier(true);
+  ReadNextAtom;
+  if AtomIsChar('[') then begin
+    // read parameter list
+    ReadTilBracketClose(true);
+    ReadNextAtom;
+  end;
+  if not AtomIsChar(':') then
+    RaiseException('syntax error: : expected, but '+GetAtom+' found');
+  ReadNextAtom; // read type
+  AtomIsIdentifier(true);
+end;
+
+function TPascalParserTool.PropertyIsDefault(PropertyNode: TCodeTreeNode
+  ): boolean;
+begin
+  Result:=false;
+  if (PropertyNode=nil) or (PropertyNode.Desc<>ctnProperty) then exit;
+  MoveCursorToCleanPos(PropertyNode.EndPos);
+  ReadPriorAtom;
+  if (not AtomIsChar(';')) then exit;
+  ReadPriorAtom;
+  Result:=UpAtomIs('DEFAULT');
+end;
+
+procedure TPascalParserTool.BuildSubTreeForProcHead(ProcNode: TCodeTreeNode);
+var HasForwardModifier, IsFunction: boolean;
+begin
+  if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent;
+  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure)
+  or (ProcNode.FirstChild=nil) then
+    RaiseException('[TPascalParserTool.BuildSubTreeForProcHead] '
+      +'internal error: invalid ProcNode');
+  if ProcNode.FirstChild.SubDesc=ctnsProcHeadNodesCreated then exit;
+  MoveCursorToNodeStart(ProcNode);
+  ReadNextAtom;
+  if UpAtomIs('CLASS') then
+    ReadNextAtom;
+  IsFunction:=UpAtomIs('FUNCTION');
+  // read procedure head (= name + parameterlist + resulttype;)
+  CurNode:=ProcNode.FirstChild;
+  ReadNextAtom;// read first atom of head
+  AtomIsIdentifier(true);
+  ReadNextAtom;
+  if AtomIsChar('.') then begin
+    // read procedure name of a class method (the name after the . )
+    ReadNextAtom;
+    AtomIsIdentifier(true);
+    ReadNextAtom;
+  end;
+  // read rest of procedure head and build nodes
+  HasForwardModifier:=false;
+  ReadTilProcedureHeadEnd(false,IsFunction,false,true,HasForwardModifier);
+  ProcNode.FirstChild.SubDesc:=ctnsProcHeadNodesCreated;
+end;
+
 
 
 end.