codetools: added ctnHintModifier nodes for deprecated, unimplemented, experimental, library, platform

git-svn-id: trunk@30683 -

components/codetools/codetree.pas

@@ -105,7 +105,7 @@ const
   ctnMethodMap          = 51; // child of visibility section or AllClassInterfaces
   
   ctnProcedure          = 60;  // children: ctnProcedureHead, sections, ctnBeginBlock/ctnAsmBlock
-  ctnProcedureHead      = 61;  // children: ctnParameterList, operator: ctnVarDefinition, operator/function: ctnResultType
+  ctnProcedureHead      = 61;  // children: ctnParameterList, operator: ctnVarDefinition, operator/function: ctnIdentifier
   ctnParameterList      = 62;  // children: ctnVarDefinition
 
   ctnIdentifier         = 70;
@@ -134,6 +134,7 @@ const
   ctnGenericParams      = 93;
   ctnGenericParameter   = 94;
   ctnConstant           = 95;
+  ctnHintModifier       = 96; // deprecated, platform, unimplemented, library, experimental
 
   ctnBeginBlock         =100;
   ctnAsmBlock           =101;
@@ -417,6 +418,7 @@ begin
   ctnGenericParams: Result:='Generic Type Params';
   ctnGenericParameter: Result:='Generic Type Parameter';
   ctnConstant: Result:='Constant';
+  ctnHintModifier: Result:='Hint Modifier';
 
   ctnWithVariable: Result:='With Variable';
   ctnWithStatement: Result:='With Statement';

components/codetools/identcompletiontool.pas

@@ -50,7 +50,7 @@ uses
   Classes, SysUtils, FileProcs, CodeTree, CodeAtom, CustomCodeTool,
   CodeToolsStrConsts, KeywordFuncLists, BasicCodeTools, LinkScanner,
   AVL_Tree, CodeToolMemManager, DefineTemplates,
-  SourceChanger, FindDeclarationTool, PascalParserTool;
+  SourceChanger, FindDeclarationTool, PascalReaderTool, PascalParserTool;
   
 
 type
@@ -91,6 +91,12 @@ type
     iliHasParamList,
     iliIsReadOnlyValid,
     iliIsReadOnly,
+    iliAreHintModifiersValid,
+    iliIsDeprecated,
+    iliIsPlatform,
+    iliIsExperimental,
+    iliIsUnimplemented,
+    iliIsLibrary,
     iliAtCursor // the item is the identifier at the completion
     );
   TIdentListItemFlags = set of TIdentListItemFlag;
@@ -143,6 +149,7 @@ type
     function IsProcNodeWithParams: boolean;
     function IsPropertyWithParams: boolean;
     function IsPropertyReadOnly: boolean;
+    function GetHintModifiers: TPascalHintModifiers;
     function CheckHasChilds: boolean;
     function CanBeAssigned: boolean;
     procedure UpdateBaseContext;
@@ -2775,12 +2782,12 @@ var
   ANode: TCodeTreeNode;
 begin
   if not (iliHasParamListValid in Flags) then begin
+    Include(Flags,iliHasParamListValid);
     ANode:=Node;
     if (ANode<>nil) and Tool.PropertyNodeHasParamList(ANode) then
       Include(Flags,iliHasParamList)
     else
       Exclude(Flags,iliHasParamList);
-    Include(Flags,iliHasParamListValid)
   end;
   Result:=iliHasParamList in Flags;
 end;
@@ -2790,17 +2797,42 @@ var
   ANode: TCodeTreeNode;
 begin
   if not (iliIsReadOnlyValid in Flags) then begin
+    Include(Flags,iliIsReadOnlyValid);
     ANode:=Node;
     if (ANode<>nil) and Tool.PropertyHasSpecifier(ANode,'read',false)
     and not Tool.PropertyHasSpecifier(ANode,'write',false) then
       Include(Flags,iliIsReadOnly)
     else
       Exclude(Flags,iliIsReadOnly);
-    Include(Flags,iliIsReadOnlyValid)
   end;
   Result:=iliIsReadOnly in Flags;
 end;
 
+function TIdentifierListItem.GetHintModifiers: TPascalHintModifiers;
+var
+  ANode: TCodeTreeNode;
+begin
+  if not (iliAreHintModifiersValid in Flags) then begin
+    Include(Flags,iliAreHintModifiersValid);
+    ANode:=Node;
+    if ANode<>nil then begin
+      Result:=Tool.GetHintModifiers(ANode);
+      if phmDeprecated in Result then Include(Flags,iliIsDeprecated);
+      if phmPlatform in Result then Include(Flags,iliIsPlatform);
+      if phmLibrary in Result then Include(Flags,iliIsLibrary);
+      if phmUnimplemented in Result then Include(Flags,iliIsUnimplemented);
+      if phmExperimental in Result then Include(Flags,iliIsExperimental);
+    end;
+  end else begin
+    Result:=[];
+    if iliIsDeprecated in Flags then Include(Result,phmDeprecated);
+    if iliIsPlatform in Flags then Include(Result,phmPlatform);
+    if iliIsLibrary in Flags then Include(Result,phmLibrary);
+    if iliIsUnimplemented in Flags then Include(Result,phmUnimplemented);
+    if iliIsExperimental in Flags then Include(Result,phmExperimental);
+  end;
+end;
+
 function TIdentifierListItem.CheckHasChilds: boolean;
 // returns true if test was successful
 var

components/codetools/pascalparsertool.pas

@@ -206,6 +206,7 @@ type
     function ReadWithStatement(ExceptionOnError, CreateNodes: boolean): boolean;
     function ReadOnStatement(ExceptionOnError, CreateNodes: boolean): boolean;
     procedure ReadVariableType;
+    function ReadHintModifier: boolean;
     function ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode): boolean;
     procedure ReadGUID;
     procedure ReadClassInheritance(CreateChildNodes: boolean);
@@ -2260,21 +2261,9 @@ begin
       UndoReadNextAtom;
 
     if CurPos.Flag=cafSemicolon then begin
-      // read hint directives
+      // read hint modifiers
       ReadNextAtom;
-      if UpAtomIs('DEPRECATED') then begin
-        ReadNextAtom;
-        if AtomIsStringConstant then
-          ReadConstant(true,false,[]);
-        if CurPos.Flag<>cafSemicolon then
-          RaiseSemicolonAfterPropSpecMissing('deprecated');
-      end else if UpAtomIs('PLATFORM') or UpAtomIs('UNIMPLEMENTED')
-        or UpAtomIs('EXPERIMENTAL')
-      then begin
-        ReadNextAtom;
-        if CurPos.Flag<>cafSemicolon then
-          RaiseSemicolonAfterPropSpecMissing('hint directive');
-      end else
+      if not ReadHintModifier then
         UndoReadNextAtom;
     end;
 
@@ -3044,15 +3033,23 @@ procedure TPascalParserTool.ReadVariableType;
 }
 begin
   ReadNextAtom;
+  // type
   ParseType(CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
+
+  // optional: absolute
   if UpAtomIs('ABSOLUTE') then begin
     ReadNextAtom;
     ReadConstant(true,false,[]);
   end;
+
+  // optional: initial value
   if CurPos.Flag=cafEqual then
     ReadConstExpr; // read constant
-  if UpAtomIs('DEPRECATED') then
-    ReadNextAtom;
+
+  // optional: hint modifier
+  ReadHintModifier;
+
+  // semicolon and postfix modifiers
   if CurPos.Flag=cafSemicolon then begin
     // read ;
     ReadNextAtom;
@@ -3111,6 +3108,32 @@ begin
   EndChildNode;
 end;
 
+function TPascalParserTool.ReadHintModifier: boolean;
+begin
+  if UpAtomIs('DEPRECATED') or UpAtomIs('PLATFORM')
+  or UpAtomIs('UNIMPLEMENTED') or UpAtomIs('EXPERIMENTAL')
+  or UpAtomIs('LIBRARY')
+  then begin
+    //debugln(['TPascalParserTool.ReadHintModifier ',CurNode.DescAsString,' ',CleanPosToStr(CurPos.StartPos)]);
+    Result:=true;
+    CreateChildNode;
+    CurNode.Desc:=ctnHintModifier;
+    CurNode.EndPos:=CurPos.EndPos;
+    if UpAtomIs('DEPRECATED') then begin
+      ReadNextAtom;
+      if AtomIsStringConstant then begin
+        ReadConstant(true,false,[]);
+        CurNode.EndPos:=CurPos.StartPos;
+      end;
+    end else
+      ReadNextAtom;
+    if CurPos.Flag<>cafSemicolon then
+      RaiseCharExpectedButAtomFound(';');
+    EndChildNode;
+  end else
+    Result:=false;
+end;
+
 function TPascalParserTool.KeyWordFuncBeginEnd: boolean;
 // Keyword: begin, asm
 
@@ -3361,10 +3384,8 @@ begin
       if not AtomIsStringConstant then
         RaiseStringExpectedButAtomFound(ctsStringConstant);
       ReadConstant(true,false,[]);
-      if UpAtomIs('DEPRECATED') then begin
-        ReadNextAtom;
-        if AtomIsStringConstant then ReadConstant(true,false,[]);
-      end;
+      // read hint modifier
+      ReadHintModifier;
       // read ;
       if CurPos.Flag<>cafSemicolon then
         RaiseCharExpectedButAtomFound(';');
@@ -3589,6 +3610,8 @@ begin
   // read type
   ReadNextAtom;
   ParseType(CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
+  // read hint modifier
+  ReadHintModifier;
   // read ;
   if CurPos.Flag<>cafSemicolon then
     RaiseCharExpectedButAtomFound(';');
@@ -3800,17 +3823,11 @@ begin
   end;
   if CurPos.Flag=cafSemicolon then
     ReadNextAtom;
-  if UpAtomIs('DEPRECATED') then begin
-    ReadNextAtom;
-    if AtomIsStringConstant then
-      ReadConstant(true,false,[]);
-  end else if UpAtomIs('PLATFORM')
-    or UpAtomIs('UNIMPLEMENTED') or UpAtomIs('EXPERIMENTAL')
-    or UpAtomIs('LIBRARY')
-  then
-    ReadNextAtom;
+  // read hint modifier
+  ReadHintModifier;
   if CurPos.Flag=cafSemicolon then
     ReadNextAtom;
+  // read post modifiers
   if UpAtomIs('EXTERNAL') then begin
     ReadNextAtom;
     if UpAtomIs('NAME') then begin
@@ -3876,30 +3893,28 @@ begin
     // forward definition
     CurNode.SubDesc:=CurNode.SubDesc+ctnsForwardDeclaration;
   end;
-  // close class interface
-  CurNode.EndPos:=CurPos.EndPos;
-  EndChildNode;
   if CurPos.Flag=cafEND then begin
     ReadNextAtom;
     if CurPos.Flag=cafSemicolon then
       ReadNextAtom;
-    if UpAtomIs('DEPRECATED') then begin
+    // read hint modifier
+    ReadHintModifier;
+    if CurPos.Flag=cafSemicolon then
       ReadNextAtom;
-      if AtomIsStringConstant then
-        ReadConstant(true,false,[]);
-    end else if UpAtomIs('EXTERNAL') then begin
+    // read post modifiers
+    if UpAtomIs('EXTERNAL') then begin
       ReadNextAtom;
       if UpAtomIs('NAME') then begin
         ReadNextAtom;
         ReadConstant(true,false,[]);
       end;
-    end else if UpAtomIs('PLATFORM') or UpAtomIs('UNIMPLEMENTED') or
-       UpAtomIs('EXPERIMENTAL') or UpAtomIs('LIBRARY')
-    then
-      ReadNextAtom;
+    end;
     if CurPos.Flag<>cafSemicolon then
       UndoReadNextAtom;
   end;
+  // close class interface
+  CurNode.EndPos:=CurPos.EndPos;
+  EndChildNode;
   Result:=true;
 end;
 
@@ -4223,15 +4238,6 @@ begin
         SaveRaiseException(ctsInvalidType);
     end;
   end;
-  if UpAtomIs('PLATFORM') or UpAtomIs('UNIMPLEMENTED') or
-     UpAtomIs('EXPERIMENTAL') or UpAtomIs('LIBRARY')
-  then
-    ReadNextAtom;
-  if UpAtomIs('DEPRECATED') then begin
-    ReadNextAtom;
-    if AtomIsStringConstant then
-      ReadConstant(true,false,[]);
-  end;
   EndChildNode;
   Result:=true;
 end;

components/codetools/pascalreadertool.pas

@@ -42,6 +42,14 @@ uses
   SourceChanger, LinkScanner, AVL_Tree;
 
 type
+  TPascalHintModifier = (
+    phmDeprecated,
+    phmPlatform,
+    phmLibrary,
+    phmUnimplemented,
+    phmExperimental
+    );
+  TPascalHintModifiers = set of TPascalHintModifier;
 
   { TPascalReaderTool }
 
@@ -64,6 +72,7 @@ type
         StartPos, MinPos, MaxPos, MaxLen: integer): string;
     function ReadStringConstantValue(StartPos: integer): string;
     function GetNodeIdentifier(Node: TCodeTreeNode): PChar;
+    function GetHintModifiers(Node: TCodeTreeNode): TPascalHintModifiers;
 
     // properties
     function ExtractPropType(PropNode: TCodeTreeNode;
@@ -792,28 +801,42 @@ procedure TPascalReaderTool.MoveCursorToFirstProcSpecifier(
 // CurPos will stand on the first proc specifier or on a semicolon
 begin
   //DebugLn(['TPascalReaderTool.MoveCursorToFirstProcSpecifier ',ProcNode.DescAsString,' ',ProcNode.StartPos]);
-  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then begin
+  if (ProcNode<>nil) and (ProcNode.Desc<>ctnProcedureHead) then
+    ProcNode:=ProcNode.FirstChild;
+  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureHead) then begin
     SaveRaiseException('Internal Error in'
       +' TPascalParserTool.MoveCursorFirstProcSpecifier: '
       +' (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure)');
   end;
-  if ProcNode.FirstChild=nil then exit;
-  MoveCursorToNodeStart(ProcNode.FirstChild);
-  ReadNextAtom;
-  if AtomIsIdentifier(false) then begin
-    // read name
+  if (ProcNode.LastChild<>nil) and (ProcNode.LastChild.Desc=ctnIdentifier) then
+  begin
+    // jump behind function result type
+    MoveCursorToCleanPos(ProcNode.LastChild.EndPos);
     ReadNextAtom;
-    if (CurPos.Flag=cafPoint) then begin
-      // read method name
+  end else if (ProcNode.FirstChild<>nil)
+    and (ProcNode.FirstChild.Desc=ctnParameterList)
+  then begin
+    // jump behind parameter list
+    MoveCursorToCleanPos(ProcNode.FirstChild.EndPos);
+    ReadNextAtom;
+  end else begin
+    MoveCursorToNodeStart(ProcNode);
+    ReadNextAtom;
+    if AtomIsIdentifier(false) then begin
+      // read name
       ReadNextAtom;
+      if (CurPos.Flag=cafPoint) then begin
+        // read method name
+        ReadNextAtom;
+        ReadNextAtom;
+      end;
+    end;
+    if (CurPos.Flag=cafRoundBracketOpen) then begin
+      // read paramlist
+      ReadTilBracketClose(false);
       ReadNextAtom;
     end;
   end;
-  if (CurPos.Flag=cafRoundBracketOpen) then begin
-    // read paramlist
-    ReadTilBracketClose(false);
-    ReadNextAtom;
-  end;
   if (CurPos.Flag=cafColon) then begin
     // read function result type
     ReadNextAtom;
@@ -1385,6 +1408,82 @@ begin
   end;
 end;
 
+function TPascalReaderTool.GetHintModifiers(Node: TCodeTreeNode
+  ): TPascalHintModifiers;
+
+  function IsHintModifier: boolean;
+  begin
+    if CurPos.Flag<>cafWord then exit(false);
+    Result:=true;
+    if UpAtomIs('PLATFORM') then
+      Include(GetHintModifiers,phmPlatform)
+    else if UpAtomIs('UNIMPLEMENTED') then
+      Include(GetHintModifiers,phmUnimplemented)
+    else if UpAtomIs('LIBRARY') then
+      Include(GetHintModifiers,phmLibrary)
+    else if UpAtomIs('EXPERIMENTAL') then
+      Include(GetHintModifiers,phmExperimental)
+    else if UpAtomIs('DEPRECATED') then
+      Include(GetHintModifiers,phmDeprecated)
+    else
+      Result:=false;
+  end;
+
+begin
+  Result:=[];
+  if Node=nil then exit;
+  case Node.Desc of
+
+  ctnProgram,ctnPackage,ctnLibrary,ctnUnit:
+    begin
+      MoveCursorToNodeStart(Node);
+      ReadNextAtom;
+      if not (UpAtomIs('PROGRAM') or UpAtomIs('PACKAGE') or UpAtomIs('LIBRARY')
+        or UpAtomIs('UNIT')) then exit;
+      ReadNextAtom;// name
+      while IsHintModifier do ReadNextAtom;
+    end;
+
+  ctnProcedure,ctnProcedureType,ctnProcedureHead:
+    begin
+      if Node.Desc<>ctnProcedureHead then begin
+        Node:=Node.FirstChild;
+        if Node=nil then exit;
+      end;
+      MoveCursorToFirstProcSpecifier(Node);
+      // ToDo:
+    end;
+
+  ctnProperty:
+    begin
+      Node:=Node.LastChild;
+      while Node<>nil do begin
+        if Node.Desc=ctnHintModifier then begin
+          MoveCursorToNodeStart(Node);
+          ReadNextAtom;
+          IsHintModifier;
+        end;
+        Node:=Node.PriorBrother;
+      end;
+    end;
+
+  ctnVarDefinition,ctnConstant,ctnTypeDefinition,ctnGenericType:
+    begin
+      Node:=FindTypeNodeOfDefinition(Node);
+      if Node=nil then exit;
+      while (Node<>nil) do begin
+        if Node.Desc=ctnHintModifier then begin
+          MoveCursorToNodeStart(Node);
+          ReadNextAtom;
+          IsHintModifier;
+        end;
+        Node:=Node.NextBrother;
+      end;
+    end;
+
+  end;
+end;
+
 function TPascalReaderTool.FindVarNode(StartNode: TCodeTreeNode;
   const UpperVarName: string): TCodeTreeNode;
 begin

ide/sourceeditprocs.pas

@@ -224,6 +224,7 @@ var
   SubNode: TCodeTreeNode;
   IsReadOnly: boolean;
   ImageIndex: longint;
+  HintModifiers: TPascalHintModifiers;
 begin
   ForegroundColor := ColorToRGB(ACanvas.Font.Color);
   Result.X := 0;
@@ -233,7 +234,7 @@ begin
     IdentItem:=CodeToolBoss.IdentifierList.FilteredItems[Index];
     if IdentItem=nil then begin
       if not MeasureOnly then
-        ACanvas.TextOut(x+1, y, 'PaintCompletionItem: BUG in codetools');
+        ACanvas.TextOut(x+1, y, 'PaintCompletionItem: BUG in codetools or misuse of PaintCompletionItem');
       exit;
     end;
     BackgroundColor:=ColorToRGB(ACanvas.Brush.Color);
@@ -343,6 +344,12 @@ begin
     end;
     ACanvas.Font.Style:=ACanvas.Font.Style-[fsBold];
 
+    if ImageIndex<0 then begin
+      HintModifiers:=IdentItem.GetHintModifiers;
+      if HintModifiers<>[] then
+        ImageIndex:=IDEImages.LoadImage(16,'ce_property_readonly');
+    end;
+
     // paint icon
     if ImageIndex>=0 then begin
       if MeasureOnly then