codetools: parse param list

git-svn-id: trunk@30584 -

components/codetools/basiccodetools.pas

@@ -53,6 +53,9 @@ function FindCommentEnd(const ASource: string; StartPos: integer;
 function IsCommentEnd(const ASource: string; EndPos: integer): boolean;
 function FindNextComment(const ASource: string;
     StartPos: integer; MaxPos: integer = 0): integer;
+procedure FindCommentsInRange(const Src: string; StartPos, EndPos: integer;
+    out FirstCommentStart, FirstAtomStart, LastCommentEnd, LastAtomEnd: integer;
+    NestedComments: boolean = false);
 function FindNextCompilerDirective(const ASource: string; StartPos: integer;
     NestedComments: boolean): integer;
 function FindNextCompilerDirectiveWithName(const ASource: string;
@@ -1176,6 +1179,50 @@ begin
   if Result>MaxPos+1 then Result:=MaxPos+1;
 end;
 
+procedure FindCommentsInRange(const Src: string; StartPos, EndPos: integer;
+  out FirstCommentStart, FirstAtomStart, LastCommentEnd, LastAtomEnd: integer;
+  NestedComments: boolean);
+var
+  p: PChar;
+  i: integer;
+  AtomStart: integer;
+  SrcLen: Integer;
+begin
+  FirstCommentStart:=0;
+  FirstAtomStart:=0;
+  LastCommentEnd:=0;
+  LastAtomEnd:=0;
+  SrcLen:=length(Src);
+  if (StartPos<1) then StartPos:=1;
+  if StartPos>SrcLen then exit;
+  if EndPos>SrcLen then EndPos:=SrcLen+1;
+  i:=StartPos;
+  while i<EndPos do begin
+    p:=@Src[i];
+    // skip space
+    while IsSpaceChar[p^] do inc(p);
+    i:=p-PChar(Src)+1;
+    if i>=EndPos then exit;
+
+    if (p^='{') or ((p^='(') and (p[1]='*')) or ((p^='/') and (p[1]='/')) then
+    begin
+      // a comment
+      if FirstCommentStart=0 then
+        FirstCommentStart:=i;
+      i:=FindCommentEnd(Src,i,NestedComments);
+      if LastCommentEnd=0 then
+        LastCommentEnd:=i;
+    end else begin
+      // normal atom
+      if FirstAtomStart=0 then
+        FirstAtomStart:=i;
+      ReadRawNextPascalAtom(Src,i,AtomStart);
+      if LastAtomEnd=0 then
+        LastAtomEnd:=i;
+    end;
+  end;
+end;
+
 function FindNextCompilerDirective(const ASource: string; StartPos: integer;
   NestedComments: boolean): integer;
 var
@@ -1288,7 +1335,7 @@ end;
 
 function FindCommentEnd(const ASource: string; StartPos: integer;
   NestedComments: boolean): integer;
-// returns position after the comment end, e.g. after {
+// returns position after the comment end, e.g. after }
 var
   MaxPos, CommentLvl: integer;
 begin

components/codetools/changedeclarationtool.pas

@@ -33,7 +33,7 @@ interface
 uses
   Classes, SysUtils, AVL_Tree, contnrs,
   FileProcs, CodeTree, CodeAtom, ExtractProcTool, FindDeclarationTool,
-  LinkScanner, SourceChanger;
+  BasicCodeTools, KeywordFuncLists, LinkScanner, SourceChanger;
 
 type
   TChangeParamListAction = (
@@ -66,6 +66,7 @@ type
 
   TChangeDeclarationTool = class(TExtractProcTool)
   private
+    procedure CDTParseParamList(ParentNode: TCodeTreeNode; Transactions: TObject);
     function ChangeParamListDeclaration(ParentNode: TCodeTreeNode;
       Changes: TObjectList; // list of TChangeParamListItem
       SourceChanger: TSourceChangeCache): boolean;
@@ -87,7 +88,7 @@ type
 
   TChangeParamTransactionInsert = class
   public
-    Src: string; // if Src='' then use Modifier+Name+Typ
+    Src: string; // if Src='' then use Modifier+Name+Typ+Value
     Modifier: string;
     Name: string;
     Typ: string;
@@ -102,6 +103,17 @@ type
   TChangeParamTransactionPos = class
   public
     Node: TCodeTreeNode; // old param node
+    // example: (var buf; {header} a,b:c; d:word=3 {footer}; ...)
+    HeaderCommentPos: integer;
+    Modifier: TAtomPosition; // ... (macpas varargs), const, var out, constref
+    Name: TAtomPosition; // '...' has no name
+    Typ: TAtomPosition;
+    DefaultValue: TAtomPosition;
+    HasComments: boolean;
+    FooterCommentEndPos: integer;
+    FirstInGroup: integer; // index of first parameter i a group, e.g. a,b:c
+    LastInGroup: integer;
+
     Delete: boolean;
     NewDefaultValue: string;
     InsertBehind: TObjectList;// list of TChangeParamTransactionInsert
@@ -116,6 +128,9 @@ type
     OldNodes: array of TChangeParamTransactionPos; // one for each old param node
     InsertFirst: TObjectList;// list of TChangeParamTransactionInsert
     Node: TCodeTreeNode; // ctnParameterList
+    BehindNamePos: integer;
+    BracketOpenPos: integer;
+    BracketClosePos: integer;
     constructor Create(ParamList: TCodeTreeNode);
     destructor Destroy; override;
     function MaxPos: integer;
@@ -227,6 +242,112 @@ end;
 
 { TChangeDeclarationTool }
 
+procedure TChangeDeclarationTool.CDTParseParamList(ParentNode: TCodeTreeNode;
+  Transactions: TObject);
+var
+  t: TChangeParamListTransactions;
+  ParamIndex: Integer;
+  CurParam: TChangeParamTransactionPos;
+  FirstInGroup: integer;
+  i: LongInt;
+  CloseBracket: Char;
+
+  procedure ReadPrefixModifier;
+  begin
+    // read parameter prefix modifier
+    if UpAtomIs('VAR') or UpAtomIs('CONST') or UpAtomIs('CONSTREF')
+    or (UpAtomIs('OUT') and (Scanner.CompilerMode in [cmOBJFPC,cmDELPHI,cmFPC]))
+    then begin
+      CurParam.Modifier:=CurPos;
+      ReadNextAtom;
+    end;
+  end;
+
+begin
+  t:=Transactions as TChangeParamListTransactions;
+  // parse param list
+  if ParentNode.Desc=ctnProcedureHead then
+    MoveCursorBehindProcName(ParentNode)
+  else if ParentNode.Desc=ctnProperty then
+    MoveCursorBehindPropName(ParentNode)
+  else
+    raise Exception.Create('TChangeDeclarationTool.ChangeParamListDeclaration kind not supported: '+ParentNode.DescAsString);
+  t.BehindNamePos:=LastAtoms.GetValueAt(0).EndPos;
+  // read bracket
+  if CurPos.Flag=cafRoundBracketOpen then
+    CloseBracket:=')'
+  else if CurPos.Flag=cafEdgedBracketOpen then
+    CloseBracket:=']'
+  else
+    exit; // no param list
+
+  t.BracketOpenPos:=CurPos.StartPos;
+  ParamIndex:=0;
+  ReadNextAtom;
+  repeat
+    CurParam:=t.OldNodes[ParamIndex];
+    FirstInGroup:=-1;
+    if AtomIs('...') then begin
+      // MacPas '...' VarArgs parameter
+      ReadNextAtom;
+      // parse end of parameter list
+      if (CurPos.StartPos>SrcLen)
+      or (Src[CurPos.StartPos]<>CloseBracket) then
+        RaiseCharExpectedButAtomFound(CloseBracket);
+      break;
+    end else begin
+      ReadPrefixModifier;
+      // read parameter name(s)
+      repeat
+        AtomIsIdentifier(true);
+        CurParam.Name:=CurPos;
+        ReadNextAtom;
+        if CurPos.Flag<>cafComma then
+          break;
+        // A group. Example: b,c:char;
+        if FirstInGroup<0 then FirstInGroup:=ParamIndex;
+        inc(ParamIndex);
+        CurParam:=t.OldNodes[ParamIndex];
+        ReadNextAtom;
+      until false;
+      if FirstInGroup>=0 then begin
+        for i:=FirstInGroup to ParamIndex do begin
+          t.OldNodes[i].FirstInGroup:=FirstInGroup;
+          t.OldNodes[i].LastInGroup:=ParamIndex;
+        end;
+      end;
+      // read parameter type
+      if CurPos.Flag=cafColon then begin
+        ReadNextAtom;
+        CurParam.Typ:=CurPos;
+        if not ReadParamType(true,false,[]) then exit;
+        CurParam.Typ.EndPos:=LastAtoms.GetValueAt(0).EndPos;
+        if CurPos.Flag=cafEqual then begin
+          // read default value
+          ReadNextAtom;
+          CurParam.DefaultValue:=CurPos;
+          ReadConstant(true,false,[]);
+          CurParam.DefaultValue.EndPos:=LastAtoms.GetValueAt(0).EndPos;
+        end;
+      end;
+      // close bracket or semicolon
+      if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then begin
+        t.BracketClosePos:=CurPos.StartPos;
+        break;
+      end;
+      if CurPos.Flag<>cafSemicolon then
+        RaiseCharExpectedButAtomFound(CloseBracket);
+      inc(ParamIndex);
+    end;
+  until false;
+
+  // check for each parameter if it has comments
+  for i:=0 to t.MaxPos-1 do begin
+    CurParam:=t.OldNodes[i];
+    // ToDo:
+  end;
+end;
+
 function TChangeDeclarationTool.ChangeParamListDeclaration(
   ParentNode: TCodeTreeNode; Changes: TObjectList;
   SourceChanger: TSourceChangeCache): boolean;
@@ -249,8 +370,7 @@ begin
     ParamListNode:=nil;
   Transactions:=TChangeParamListTransactions.Create(ParamListNode);
   try
-    // ToDo: parse param list
-
+    CDTParseParamList(ParentNode,Transactions);
 
     for i:=0 to Changes.Count-1 do begin
       Change:=TChangeParamListItem(Changes[i]);

components/codetools/codetree.pas

@@ -164,11 +164,11 @@ const
   AllClassModifiers = [ctnClassAbstract, ctnClassSealed, ctnClassExternal];
   AllDefinitionSections =
      [ctnTypeSection,ctnVarSection,ctnConstSection,ctnResStrSection,
-      ctnLabelSection];
-  AllIdentifierDefinitions =
-     [ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,ctnGenericType];
+      ctnLabelSection,ctnPropertySection];
   AllSimpleIdentifierDefinitions =
      [ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition];
+  AllIdentifierDefinitions = AllSimpleIdentifierDefinitions
+     +[ctnGenericType,ctnGlobalProperty];
   AllPascalTypes =
      AllClasses+
      [ctnGenericType,ctnSpecialize,

components/codetools/pascalparsertool.pas

@@ -1167,21 +1167,6 @@ function TPascalParserTool.ReadParamList(ExceptionOnError, Extract: boolean;
    procedure Intf.Method = ImplementingMethodName;
    function CommitUrlCacheEntry; // only Delphi
    procedure MacProcName(c: char; ...); external;
-
- proc specifiers without parameters:
-   stdcall, virtual, abstract, dynamic, overload, override, cdecl, inline
-
- proc specifiers with parameters:
-   message <id or number>;
-   external;
-   external <id>;
-   external name <id> delayed;
-   external <id or number> name <id>;
-   external <id or number> index <id>;
-   [alias: <string constant>]
-   [external name <string constant>]
-   [internconst:in_const_round, external name 'FPC_ROUND'];
-   dispid <id>;
 }
 var CloseBracket: char;
   Desc: TCodeTreeNodeDesc;

components/codetools/pascalreadertool.pas

@@ -70,6 +70,7 @@ type
                              InUpperCase, EmptyIfIndexed: boolean): string;
     function MoveCursorToPropType(PropNode: TCodeTreeNode): boolean;
     function MoveCursorToPropName(PropNode: TCodeTreeNode): boolean;
+    procedure MoveCursorBehindPropName(PropNode: TCodeTreeNode);
     function ExtractPropName(PropNode: TCodeTreeNode;
                              InUpperCase: boolean): string;
     function ExtractProperty(PropNode: TCodeTreeNode;
@@ -1022,6 +1023,22 @@ begin
   Result:=CurPos.Flag=cafWord;
 end;
 
+procedure TPascalReaderTool.MoveCursorBehindPropName(PropNode: TCodeTreeNode);
+begin
+  if (PropNode=nil)
+  or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
+    exit;
+  MoveCursorToNodeStart(PropNode);
+  ReadNextAtom;
+  if (PropNode.Desc=ctnProperty) then begin
+    if UpAtomIs('CLASS') then ReadNextAtom;
+    if (not UpAtomIs('PROPERTY')) then exit;
+    ReadNextAtom;
+  end;
+  if not AtomIsIdentifier(false) then exit;
+  ReadNextAtom;
+end;
+
 function TPascalReaderTool.ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
   ProcSpec: TProcedureSpecifier): boolean;
 begin