Jedi Code Format: Support anonymous methods. Issue #39928, patch by Domingo Galmés.

components/jcf2/Parse/BuildParseTree.pas

@@ -206,8 +206,8 @@ type
     procedure RecogniseInline;
     procedure RecogniseInlineItem;
 
-    procedure RecogniseFunctionDecl(const pbAnon: boolean);
-    procedure RecogniseProcedureDecl(const pbAnon: boolean);
+    procedure RecogniseFunctionDecl(const pbAnon: boolean;pbIsNamedAnonymous:boolean=false);
+    procedure RecogniseProcedureDecl(const pbAnon: boolean;pbIsNamedAnonymous:boolean=false);
     procedure RecogniseSquareBracketDir;
     procedure RecogniseConstructorDecl;
     procedure RecogniseDestructorDecl;
@@ -2859,7 +2859,7 @@ begin
 
   CheckSpecialize(True);
   lt := fcTokenList.FirstSolidTokenType;
-  if AnonymousMethodNext then
+  if lt in [ttProcedure, ttFunction] then
   begin
     RecogniseAnonymousMethod;
   end
@@ -3043,16 +3043,25 @@ end;
 procedure TBuildParseTree.RecogniseAnonymousMethod;
 var
   lt: TTokenType;
+  lIsNamedAnonymous:boolean;
 begin
+  {// this code compiles without error (anonymous Method with name?? )
+   i := function foo:integer
+      begin
+         foo:= 4711;
+      end;
+  }
+  lIsNamedAnonymous := not AnonymousMethodNext;
+
   lt := fcTokenList.FirstSolidTokenType;
 
   PushNode(nAnonymousMethod);
 
   case lt of
     ttProcedure:
-      RecogniseProcedureDecl(true);
+      RecogniseProcedureDecl(true,lIsNamedAnonymous);
     ttFunction:
-      RecogniseFunctionDecl(true);
+      RecogniseFunctionDecl(true,lIsNamedAnonymous);
   else
     RaiseParseError('Unexpected token in RecogniseAnonymousMethod', fcTokenList.FirstSolidToken);
   end;
@@ -3446,6 +3455,8 @@ begin
     // empty statement
     // this gets doen later in common code Recognise(ttSemicolon);
   end
+  else if lt in[ttProcedure,ttFunction] then  //anonymous function or procedure
+      RecogniseExpr(True)
   else
   begin
     RaiseParseError('Expected simple statement', fcTokenList.FirstSolidToken);
@@ -4074,9 +4085,10 @@ begin
     result := False;
 end;
 
-procedure TBuildParseTree.RecogniseProcedureDecl(const pbAnon: boolean);
+procedure TBuildParseTree.RecogniseProcedureDecl(const pbAnon: boolean;pbIsNamedAnonymous:boolean=false);
 var
   lcTop: TParseTreeNode;
+  lbAnon:boolean;
 begin
   { ProcedureDecl -> ProcedureHeading ';' [Directive] Block ';'
 
@@ -4085,7 +4097,10 @@ begin
   }
   PushNode(nProcedureDecl);
 
-  RecogniseProcedureHeading(pbAnon, False);
+  lbAnon:=pbAnon;
+  if pbIsNamedAnonymous then
+    lbAnon:=false;
+  RecogniseProcedureHeading(lbAnon, False);
 
   { the ';' is ommited by lazy programmers in some rare occasions}
   if fcTokenList.FirstSolidTokenType = ttSemicolon then
@@ -4115,15 +4130,19 @@ begin
   PopNode;
 end;
 
-procedure TBuildParseTree.RecogniseFunctionDecl(const pbAnon: boolean);
+procedure TBuildParseTree.RecogniseFunctionDecl(const pbAnon: boolean;pbIsNamedAnonymous:boolean=false);
 var
   lcTop: TParseTreeNode;
+  lbAnon:boolean;
 begin
   // ProcedureDecl -> FunctionHeading ';' [Directive] Block ';'
 
   PushNode(nFunctionDecl);
 
-  RecogniseFunctionHeading(pbAnon, False);
+  lbAnon:=pbAnon;
+  if pbIsNamedAnonymous then
+    lbAnon:=false;
+  RecogniseFunctionHeading(lbAnon, False);
   { the ';' is ommited by lazy programmers in some rare occasions}
   if fcTokenList.FirstSolidTokenType = ttSemicolon then
     Recognise(ttSemicolon);
@@ -4332,17 +4351,25 @@ begin
     'out' with a comma, colon or ')' directly after is not a prefix, it is a param name
     if another name follows it is a prefix
   }
-
-  if fcTokenList.FirstSolidTokenType in PARAM_PREFIXES then
-    Recognise(PARAM_PREFIXES)
-  else if fcTokenList.FirstSolidTokenType = ttOut then
+  if fcTokenList.FirstSolidTokenType in [ttProcedure, ttFunction] then
   begin
-    if IsIdentifierToken(fcTokenList.SolidToken(2), idAllowDirectives) then
-      Recognise(ttOut);
+    RecogniseAnonymousMethod;
+    //parameters to anonymous procedure/function
+    if fcTokenList.FirstSolidTokenType=ttOpenBracket then
+      RecogniseActualParams;
+  end
+  else
+  begin
+    if fcTokenList.FirstSolidTokenType in PARAM_PREFIXES then
+      Recognise(PARAM_PREFIXES)
+    else if fcTokenList.FirstSolidTokenType = ttOut then
+    begin
+      if IsIdentifierToken(fcTokenList.SolidToken(2), idAllowDirectives) then
+        Recognise(ttOut);
+    end;
+
+    RecogniseParameter;
   end;
-
-  RecogniseParameter;
-
   PopNode;
 end;
 
@@ -4376,6 +4403,13 @@ begin
       Recognise(ttArray);
       Recognise(ttOf);
       lbArray := True;
+    end
+    else if fcTokenList.FirstSolidTokenType in [ttProcedure, ttFunction] then
+    begin
+      RecogniseAnonymousMethod;
+      //parameters to anonymous procedure/function
+      if fcTokenList.FirstSolidTokenType=ttOpenBracket then
+        RecogniseActualParams;
     end;
 
     // type is optional in params ie procedure foo(var pp);
@@ -6037,6 +6071,14 @@ begin
   CheckSpecialize(True);
   lc := fcTokenList.FirstSolidToken;
   CheckNilInstance(lc, fcRoot.LastLeaf);
+  if lc.TokenType in [ttProcedure, ttFunction] then
+  begin
+    RecogniseAnonymousMethod;
+    //parameters to anonymous procedure/function
+    if fcTokenList.FirstSolidTokenType=ttOpenBracket then
+      RecogniseActualParams;
+    exit;
+  end;
   { all kinds of reserved words can sometimes be param names
     thanks to COM and named params
     See LittleTest43.pas }
@@ -6051,10 +6093,6 @@ begin
     begin
       RecogniseArrayType;
     end
-    else if AnonymousMethodNext then
-    begin
-      RecogniseAnonymousMethod;
-    end
     else
     begin
       { quick surgery. Perhaps even a hack -
@@ -6105,19 +6143,10 @@ begin
 end;
 
 function TBuildParseTree.AnonymousMethodNext: boolean;
-var
-  lc, lcNext: TSourceToken;
 begin
   Result := False;
-  lc := fcTokenList.FirstSolidToken;
-  CheckNilInstance(lc, fcRoot.LastLeaf);
-
-  if lc.TokenType in [ttProcedure, ttFunction] then
-  begin
-    lcNext := fcTokenList.SolidToken(2);
-    if lcNext <> nil then
-      Result := (lcNext.TokenType in [ttOpenBracket, ttColon]);
-  end;
+  if fcTokenList.FirstSolidTokenType in [ttProcedure, ttFunction] then
+    Result := (fcTokenList.SolidTokenType(2) in [ttOpenBracket, ttColon, ttBegin]);
 end;
 
 procedure TBuildParseTree.CheckEnumeratorToken(aCheckTwoTokens:boolean);

components/jcf2/Process/Indent/Indenter.pas

@@ -413,6 +413,9 @@ begin
     liIndentCount := pt.Nestings.GetLevel(nlBlock);
     if liIndentCount > 0 then
     begin
+      if pt.HasParentNode(nAnonymousMethod)  and not (pt.TokenType in ProcedureWords) then
+        Dec(liIndentCount);
+
       // outdent keywords that start and end the block
       if pt.TokenType in BlockOutdentWords then
       begin

components/jcf2/Process/Returns/NoReturnAfter.pas

@@ -76,8 +76,9 @@ end;
 
 function TNoReturnAfter.NeedsNoReturn(const pt: TSourceToken): boolean;
 const
+  // add ttTo for "reference to procedure/function"
   NoReturnWords: TTokenTypeSet = [ttProcedure, ttFunction,
-    ttConstructor, ttDestructor, ttProperty, ttGoto, ttGeneric];
+    ttConstructor, ttDestructor, ttProperty, ttGoto, ttGeneric, ttTo];
 var
   lcSetReturns: TSetReturns;
   lcNext, lcNext2: TSourceToken;

components/jcf2/Process/Returns/NoReturnBefore.pas

@@ -56,7 +56,8 @@ uses SourceToken, TokenUtils, Tokens, ParseTreeNodeType,
 
 function HasNoReturnBefore(const pt: TSourceToken): boolean;
 const
-  NoReturnTokens: TTokenTypeSet    = [ttAssign, ttColon, ttSemiColon, ttPlusAssign, ttMinusAssign, ttTimesAssign, ttFloatDivAssign];
+  // add ttTo for "reference to procedure/function"
+  NoReturnTokens: TTokenTypeSet    = [ttAssign, ttColon, ttSemiColon, ttPlusAssign, ttMinusAssign, ttTimesAssign, ttFloatDivAssign, ttTo];
   ProcNoReturnWords: TTokenTypeSet = [ttThen, ttDo];
 var
   lcPrev: TParseTreeNode;
@@ -66,6 +67,13 @@ begin
   if pt = nil then
     exit;
 
+  if pt.TokenType=ttReference then
+    exit(true);
+
+  // referencce to procedure/function
+  if (pt.TokenType in [ttFunction,ttProcedure]) and (pt.PriorSolidTokenType=ttTo) then
+    exit(true);
+
   //var
   //  Test : function: Integer; // No New Line
   //type

components/jcf2/Process/Returns/ReturnBefore.pas

@@ -382,9 +382,13 @@ begin
   Result := False;
   lcSourceToken := TSourceToken(pcToken);
   lcNext := lcSourceToken.NextToken;
-  if lcNext = nil then
+  if (lcSourceToken=nil) or (lcNext = nil) then
     exit;
 
+  //reference to procedure/function
+  if (lcSourceToken.TokenType in [ttProcedure,ttFunction]) and (lcSourceToken.PriorSolidTokenType=ttTo) then
+    exit(false);
+
   liReturnsNeeded := 0;
 
   if NeedsBlankLine(lcSourceToken) then

components/jcf2/Process/Spacing/SingleSpaceAfter.pas

@@ -141,6 +141,11 @@ begin
 
   if (pt.TokenType in SingleSpaceAfterWords) then
   begin
+    // reference to procedure/function(param1:typeparam1)
+    // Anonymous Functions   procedure(param1:typeparam1)
+    if (pt.TokenType in [ttProcedure,ttFunction]) and (ptNext.TokenType in
+      [ttOpenBracket, ttSemiColon]) then
+      exit(false);
     { 'procedure' and 'function' in proc type def don't have space after, e.g.
       type
         TFredProc = procedure(var psFred: integer); }