implemented ... VarArgs parameter for mode MacPas

git-svn-id: trunk@7914 -

components/codetools/customcodetool.pas

@@ -1018,10 +1018,16 @@ begin
       begin
         inc(CurPos.EndPos);
         if (Src[CurPos.EndPos]<>'.') then begin
+          // '.'
           CurPos.Flag:=cafPoint;
         end else begin
-          // ..
           inc(CurPos.EndPos);
+          if (Src[CurPos.EndPos]<>'.') then begin
+            // '..'
+          end else begin
+            // '...'
+            inc(CurPos.EndPos);
+          end;
         end;
       end;
     else
@@ -1029,12 +1035,15 @@ begin
       c2:=Src[CurPos.EndPos];
       // test for double char operators :=, +=, -=, /=, *=, <>, <=, >=, **, ><
       if ((c2='=') and  (IsEqualOperatorStartChar[c1]))
-      or ((c1='<') and (c2='>')) // not equal
+        or ((c1='<') and (c2='>')) // not equal
-      or ((c1='>') and (c2='<'))
+        or ((c1='>') and (c2='<'))
-      or ((c1='.') and (c2='.')) // subrange
+        or ((c1='.') and (c2='.'))
-      or ((c1='*') and (c2='*'))
+        or ((c1='*') and (c2='*'))
-      then inc(CurPos.EndPos);
+        then begin
-      if ((c1='@') and (c2='@')) then begin
+          // 2 character operator/symbol
+          inc(CurPos.EndPos);
+      end
+      else if ((c1='@') and (c2='@')) then begin
         // @@ label
         repeat
           inc(CurPos.EndPos);

components/codetools/pascalparsertool.pas

@@ -983,10 +983,38 @@ end;
 
 function TPascalParserTool.ReadParamList(ExceptionOnError, Extract: boolean;
   const Attr: TProcHeadAttributes): boolean;
+{ parse parameter list
+
+ examples:
+   procedure ProcName;  virtual; abstract;
+   function FuncName(Parameter1: Type1; Parameter2: Type2): ResultType;
+   constructor Create;
+   destructor Destroy;  override;
+   class function X: integer;
+   function QWidget_mouseGrabber(): QWidgetH; cdecl;
+   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>;
+   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;
   Node: TCodeTreeNode;
-  
+
   procedure ReadPrefixModifier;
   begin
     // read parameter prefix modifier
@@ -1038,56 +1066,74 @@ begin
     CloseBracket:=#0;
   if not (CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose]) then begin
     repeat
-      ReadPrefixModifier;
+      if AtomIs('...') then begin
-      // read parameter name(s)
+        // MacPas '...' VarArgs parameter
-      repeat
+        if (Scanner.CompilerMode<>cmMacPas) then begin
-        if not AtomIsIdentifier(ExceptionOnError) then exit;
+          if ExceptionOnError then
-        if (phpCreateNodes in Attr) then begin
+            RaiseIdentExpectedButAtomFound
-          CreateChildNode;
+          else
-          CurNode.Desc:=Desc;
+            exit;
         end;
-        if not Extract then
+        ReadNextAtom;
-          ReadNextAtom
+        // parse end of parameter list
-        else
+        if (CurPos.StartPos>SrcLen)
-          ExtractNextAtom(phpWithParameterNames in Attr,Attr);
+        or (Src[CurPos.StartPos]<>CloseBracket) then
-        if CurPos.Flag<>cafComma then
+          if ExceptionOnError then
-          break
+            RaiseCharExpectedButAtomFound(CloseBracket)
-        else begin
+          else exit;
+        break;
+      end else begin
+        ReadPrefixModifier;
+        // read parameter name(s)
+        repeat
+          if not AtomIsIdentifier(ExceptionOnError) then exit;
           if (phpCreateNodes in Attr) then begin
-            CurNode.EndPos:=LastAtoms.GetValueAt(0).EndPos;
+            CreateChildNode;
-            EndChildNode;
+            CurNode.Desc:=Desc;
           end;
           if not Extract then
             ReadNextAtom
           else
-            ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
+            ExtractNextAtom(phpWithParameterNames in Attr,Attr);
+          if CurPos.Flag<>cafComma then
+            break
+          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 CurPos.Flag=cafColon then begin
+          if not Extract then
+            ReadNextAtom
+          else
+            ExtractNextAtom([phpWithoutParamList,phpWithoutParamTypes]*Attr=[],
+                            Attr);
+          if not ReadParamType(ExceptionOnError,Extract,Attr) then exit;
+          if CurPos.Flag=cafEqual then begin
+            // read default value
+            ReadDefaultValue;
+          end;
+        end else begin
+          // no type -> variant
+          if (phpCreateNodes in Attr) then begin
+            CreateChildNode;
+            CurNode.Desc:=ctnVariantType;
+            CurNode.EndPos:=CurNode.StartPos;
+            EndChildNode;
+          end;
         end;
-      until false;
-      // read type
-      if CurPos.Flag=cafColon then begin
-        if not Extract then
-          ReadNextAtom
-        else
-          ExtractNextAtom([phpWithoutParamList,phpWithoutParamTypes]*Attr=[],
-                          Attr);
-        if not ReadParamType(ExceptionOnError,Extract,Attr) then exit;
-        if CurPos.Flag=cafEqual then begin
-          // read default value
-          ReadDefaultValue;
-        end;
-      end else begin
-        // no type -> variant
         if (phpCreateNodes in Attr) then begin
-          CreateChildNode;
+          CurNode.EndPos:=CurPos.EndPos;
-          CurNode.Desc:=ctnVariantType;
-          CurNode.EndPos:=CurNode.StartPos;
           EndChildNode;
         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
@@ -1097,7 +1143,7 @@ begin
         break;
       if (CurPos.Flag<>cafSemicolon) then
         if ExceptionOnError then
-          RaiseCharExpectedButAtomFound(CloseBracket)
+          RaiseCharExpectedButAtomFound(';')
         else exit;
       if not Extract then
         ReadNextAtom
@@ -1200,10 +1246,6 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
   var HasForwardModifier: boolean): boolean;
 { parse parameter list, result type, of object, method specifiers
 
-  IsMethod: true if parsing in a class/object
-  IsFunction: 'function'
-  IsType: parsing type definition. e.g. 'Event: procedure of object'
-
 
  examples:
    procedure ProcName;  virtual; abstract;
@@ -1214,6 +1256,7 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
    function QWidget_mouseGrabber(): QWidgetH; cdecl;
    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