IDE+codetools: implemented Extract Function, issue #13108

git-svn-id: trunk@19188 -

components/codetools/codetoolmanager.pas

@@ -497,12 +497,14 @@ type
     function CheckExtractProc(Code: TCodeBuffer;
           const StartPoint, EndPoint: TPoint;
           out MethodPossible, SubProcSameLvlPossible: boolean;
-          out MissingIdentifiers: TAVLTree // tree of PCodeXYPosition
+          out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition
+          VarTree: TAVLTree = nil  // tree of TExtractedProcVariable
           ): boolean;
     function ExtractProc(Code: TCodeBuffer; const StartPoint, EndPoint: TPoint;
           ProcType: TExtractProcType; const ProcName: string;
           IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
-          var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer
+          var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer;
+          FunctionResultVariableStartPos: integer = 0
           ): boolean;
 
     // code templates
@@ -3497,7 +3499,8 @@ end;
 
 function TCodeToolManager.CheckExtractProc(Code: TCodeBuffer; const StartPoint,
   EndPoint: TPoint; out MethodPossible, SubProcSameLvlPossible: boolean;
-  out MissingIdentifiers: TAVLTree // tree of PCodeXYPosition
+  out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition
+  VarTree: TAVLTree  // tree of TExtractedProcVariable
   ): boolean;
 var
   StartPos, EndPos: TCodeXYPosition;
@@ -3515,7 +3518,8 @@ begin
   EndPos.Code:=Code;
   try
     Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible,
-                                     SubProcSameLvlPossible,MissingIdentifiers);
+                                     SubProcSameLvlPossible,MissingIdentifiers,
+                                     VarTree);
   except
     on e: Exception do Result:=HandleException(e);
   end;
@@ -3524,7 +3528,8 @@ end;
 function TCodeToolManager.ExtractProc(Code: TCodeBuffer; const StartPoint,
   EndPoint: TPoint; ProcType: TExtractProcType; const ProcName: string;
   IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
-  var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean;
+  var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer;
+  FunctionResultVariableStartPos: integer): boolean;
 var
   StartPos, EndPos: TCodeXYPosition;
   NewPos: TCodeXYPosition;
@@ -3542,7 +3547,8 @@ begin
   EndPos.Code:=Code;
   try
     Result:=FCurCodeTool.ExtractProc(StartPos,EndPos,ProcType,ProcName,
-                         IgnoreIdentifiers,NewPos,NewTopLine,SourceChangeCache);
+                         IgnoreIdentifiers,NewPos,NewTopLine,SourceChangeCache,
+                         FunctionResultVariableStartPos);
     if Result then begin
       NewX:=NewPos.X;
       NewY:=NewPos.Y;

components/codetools/extractproctool.pas

@@ -49,6 +49,26 @@ uses
   FindDeclarationTool;
   
 type
+  TExtractedProcVariableType = (
+    epvtParameter,
+    epvtLocalVar
+    //epvtExternVar // variable is defined outside (e.g. a global variable or a class member)
+    );
+
+  TExtractedProcVariable = class
+  public
+    Node: TCodeTreeNode;
+    Tool: TFindDeclarationTool;
+    VarType: TExtractedProcVariableType;
+    ReadInSelection: boolean;
+    WriteInSelection: boolean;
+    UsedInNonSelection: boolean;
+    ReadAfterSelection: boolean;
+    ReadAfterSelectionValid: boolean;
+    RemovedFromOldProc: boolean;
+    function UsedInSelection: boolean;
+  end;
+
   { TExtractProcTool }
   
   TExtractProcType = (
@@ -76,13 +96,15 @@ type
   public
     function CheckExtractProc(const StartPos, EndPos: TCodeXYPosition;
       out MethodPossible, SubProcSameLvlPossible: boolean;
-      out MissingIdentifiers: TAVLTree // tree of PCodeXYPosition
+      out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition
+      VarTree: TAVLTree = nil  // tree of TExtractedProcVariable
       ): boolean;
     function ExtractProc(const StartPos, EndPos: TCodeXYPosition;
       ProcType: TExtractProcType; const ProcName: string;
       IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
       out NewPos: TCodeXYPosition; out NewTopLine: integer;
-      SourceChangeCache: TSourceChangeCache): boolean;
+      SourceChangeCache: TSourceChangeCache;
+      FunctionResultVariableStartPos: integer = 0): boolean;
   end;
   
 const
@@ -97,40 +119,16 @@ const
     'PublishedMethod'
     );
 
+function CreateExtractProcVariableTree: TAVLTree;
+procedure ClearExtractProcVariableTree(VarTree: TAVLTree; FreeTree: boolean);
+
 implementation
 
-type
-  TExtractedProcVariableType = (
-    epvtParameter,
-    epvtLocalVar
-    );
-
-  TExtractedProcVariable = class
-  public
-    Node: TCodeTreeNode;
-    VarType: TExtractedProcVariableType;
-    ReadInSelection: boolean;
-    WriteInSelection: boolean;
-    UsedInNonSelection: boolean;
-    ReadAfterSelection: boolean;
-    ReadAfterSelectionValid: boolean;
-    RemovedFromOldProc: boolean;
-    function UsedInSelection: boolean;
-  end;
-
-{ TExtractedProcVariable }
-
-function TExtractedProcVariable.UsedInSelection: boolean;
-begin
-  Result:=ReadInSelection or WriteInSelection;
-end;
-
 function CompareExtractedProcVariables(V1, V2: TExtractedProcVariable): integer;
 var
   cmp: Integer;
 begin
   cmp:=V2.Node.StartPos-V1.Node.StartPos;
-  
   if cmp<0 then
     Result:=-1
   else if cmp>0 then
@@ -153,6 +151,26 @@ begin
     Result:=0;
 end;
 
+function CreateExtractProcVariableTree: TAVLTree;
+begin
+  Result:=TAVLTree.Create(TListSortCompare(@CompareExtractedProcVariables));
+end;
+
+procedure ClearExtractProcVariableTree(VarTree: TAVLTree; FreeTree: boolean);
+begin
+  if VarTree=nil then exit;
+  VarTree.FreeAndClear;
+  if FreeTree then
+    VarTree.Free;
+end;
+
+{ TExtractedProcVariable }
+
+function TExtractedProcVariable.UsedInSelection: boolean;
+begin
+  Result:=ReadInSelection or WriteInSelection;
+end;
+
 { TExtractProcTool }
 
 function TExtractProcTool.InitExtractProc(const StartPos,
@@ -271,7 +289,7 @@ end;
 
 function TExtractProcTool.CheckExtractProc(const StartPos,
   EndPos: TCodeXYPosition; out MethodPossible, SubProcSameLvlPossible: boolean;
-  out MissingIdentifiers: TAVLTree): boolean;
+  out MissingIdentifiers: TAVLTree; VarTree: TAVLTree): boolean;
 var
   BlockStartPos: integer;
   BlockEndPos: integer;
@@ -282,7 +300,7 @@ begin
   then exit;
   MissingIdentifiers:=CreateTreeOfPCodeXYPosition;
   if not ScanNodesForVariables(StartPos,EndPos,BlockStartPos,BlockEndPos,
-                               ProcNode,nil,nil,MissingIdentifiers) then exit;
+                               ProcNode,VarTree,nil,MissingIdentifiers) then exit;
   Result:=true;
 end;
 
@@ -290,7 +308,8 @@ function TExtractProcTool.ExtractProc(const StartPos, EndPos: TCodeXYPosition;
   ProcType: TExtractProcType; const ProcName: string;
   IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
   out NewPos: TCodeXYPosition; out NewTopLine: integer;
-  SourceChangeCache: TSourceChangeCache): boolean;
+  SourceChangeCache: TSourceChangeCache;
+  FunctionResultVariableStartPos: integer): boolean;
 const
   ShortProcFormat = [phpWithoutClassKeyword];
   {$IFDEF CTDebug}
@@ -303,6 +322,29 @@ var
   BlockStartPos, BlockEndPos: integer; // the selection
   ProcNode: TCodeTreeNode; // the main proc node of the selection
   VarTree: TAVLTree;
+  ResultNode: TCodeTreeNode;
+
+  function FindFunctionResultNode: boolean;
+  var
+    AVLNode: TAVLTreeNode;
+    ProcVar: TExtractedProcVariable;
+  begin
+    Result:=false;
+    ResultNode:=nil;
+    if FunctionResultVariableStartPos<1 then exit(true); // create a proc, not a function
+    AVLNode:=VarTree.FindLowest;
+    while AVLNode<>nil do begin
+      ProcVar:=TExtractedProcVariable(AVLNode.Data);
+      if ProcVar.Node.StartPos=FunctionResultVariableStartPos then begin
+        ProcVar.UsedInNonSelection:=true;
+        ProcVar.ReadAfterSelection:=true;
+        Result:=true;
+        ResultNode:=ProcVar.Node;
+        exit;
+      end;
+      AVLNode:=VarTree.FindSuccessor(AVLNode);
+    end;
+  end;
   
   function ReplaceSelectionWithCall: boolean;
   var
@@ -319,7 +361,7 @@ var
     Indent:=GetLineIndent(Src,BlockStartPos);
     ParamListCode:='';
     // gather all variables, that are used in the selection and in the rest of
-    // the old proc. These are the parameters for the new proc.
+    // the old proc (in front or behind). These are the parameters for the new proc.
     if (VarTree<>nil) and (ProcType<>eptSubProcedure) then begin
       AVLNode:=VarTree.FindLowest;
       while AVLNode<>nil do begin
@@ -332,8 +374,9 @@ var
           ' ReadAfterSelection=',dbgs(ProcVar.ReadAfterSelection),
           '');
         {$ENDIF}
-        if ProcVar.UsedInSelection and ProcVar.UsedInNonSelection then begin
+        if (ProcVar.UsedInSelection and ProcVar.UsedInNonSelection)
-          // variables
+        and (ResultNode<>ProcVar.Node) then begin
+          // parameter
           if ParamListCode<>'' then ParamListCode:=ParamListCode+',';
           ParamListCode:=ParamListCode+GetIdentifier(@Src[ProcVar.Node.StartPos]);
         end;
@@ -343,6 +386,9 @@ var
     if ParamListCode<>'' then
       ParamListCode:='('+ParamListCode+')';
     CallCode:=ProcName+ParamListCode+';';
+    if ResultNode<>nil then begin
+      CallCode:=GetIdentifier(@Src[ResultNode.StartPos])+':='+CallCode;
+    end;
     CallCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
                                                                CallCode,Indent);
     {$IFDEF CTDebug}
@@ -564,14 +610,17 @@ var
     Result:=true;
   end;
 
-  function CreateProcParamList(out CompleteParamListCode,
+  function CreateProcParamList(
-    BaseParamListCode: string): boolean;
+    out CompleteParamListCode, // including modifiers, brackets and result type
+    BaseParamListCode: string // without modifiers and result type
+    ): boolean;
   var
     AVLNode: TAVLTreeNode;
     ProcVar: TExtractedProcVariable;
     ParamName: String;
     ParamTypeCode: String;
     ParamSpecifier: String;
+    ResultType: String;
   begin
     Result:=false;
     CompleteParamListCode:='';
@@ -590,7 +639,8 @@ var
           ' ReadAfterSelection=',dbgs(ProcVar.ReadAfterSelection),
           '');
         {$ENDIF}
-        if ProcVar.UsedInSelection and ProcVar.UsedInNonSelection then begin
+        if ProcVar.UsedInSelection and ProcVar.UsedInNonSelection
+        and (ProcVar.Node<>ResultNode) then begin
           // extract identifier and type
           if CompleteParamListCode<>'' then
             CompleteParamListCode:=CompleteParamListCode+';';
@@ -616,6 +666,10 @@ var
       CompleteParamListCode:='('+CompleteParamListCode+')';
       BaseParamListCode:='('+BaseParamListCode+')';
     end;
+    if ResultNode<>nil then begin
+      ResultType:=ExtractDefinitionNodeType(ResultNode);
+      CompleteParamListCode:=CompleteParamListCode+':'+ResultType;
+    end;
     {$IFDEF CTDebug}
     DebugLn('CreateProcParamList END CompleteParamListCode="',CompleteParamListCode,'"');
     {$ENDIF}
@@ -646,7 +700,8 @@ var
           ' UsedInNonSelection=',dbgs(ProcVar.UsedInNonSelection),
           ' ReadAfterSelection=',dbgs(ProcVar.ReadAfterSelection),'');
         {$ENDIF}
-        if ProcVar.UsedInSelection and (not ProcVar.UsedInNonSelection) then
+        if ProcVar.UsedInSelection
+        and ((not ProcVar.UsedInNonSelection) or (ProcVar.Node=ResultNode)) then
         begin
           // extract identifier and type
           if VarSectionCode='' then
@@ -692,7 +747,7 @@ var
     Result:=false;
     BeginEndCode:='';
     le:=SourceChangeCache.BeautifyCodeOptions.LineEnd;
-    // extract dirty source, so that compiler directives are moved.
+    // extract dirty source, so that compiler directives are moved too
     StartPos.Code.LineColToPosition(StartPos.Y,StartPos.X,DirtyStartPos);
     StartPos.Code.LineColToPosition(EndPos.Y,EndPos.X,DirtyEndPos);
     DirtySelection:=copy(StartPos.Code.Source,
@@ -710,6 +765,11 @@ var
                SourceChangeCache.BeautifyCodeOptions.TabWidth,
                s);
     DirtySelection:=s;
+    if ResultNode<>nil then begin
+      DirtySelection:=DirtySelection
+              +GetIndentStr(SourceChangeCache.BeautifyCodeOptions.Indent)
+              +'Result:='+GetIdentifier(@Src[ResultNode.StartPos])+';'+le;
+    end;
     // create Begin..End block
     BeginEndCode:='begin'+le
                   +DirtySelection
@@ -849,13 +909,19 @@ var
     MethodDefinition: String;
     CleanMethodDefinition: String;
     NewClassPart: TNewClassPart;
+    Keyword: String;
   begin
     Result:=false;
+    if ResultNode=nil then
+      Keyword:='procedure'
+    else
+      Keyword:='function';
+
     case ProcType of
     
     eptProcedureWithInterface:
       begin
-        ProcHeader:='procedure '+ProcName+CompleteParamList+';';
+        ProcHeader:=Keyword+' '+ProcName+CompleteParamList+';';
         ProcHeader:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
           ProcHeader,IntfIndent);
         {$IFDEF CTDebug}
@@ -883,8 +949,8 @@ var
         CodeCompleteSrcChgCache:=SourceChangeCache;
 
         // insert new method to class
-        MethodDefinition:='procedure '+ProcName+CompleteParamList+';';
+        MethodDefinition:=Keyword+' '+ProcName+CompleteParamList+';';
-        CleanMethodDefinition:='procedure '+ProcName+BaseParamList+';';
+        CleanMethodDefinition:=Keyword+' '+ProcName+BaseParamList+';';
         if ProcExistsInCodeCompleteClass(CleanMethodDefinition) then exit;
         case ProcType of
         eptPrivateMethod:   NewClassPart:=ncpPrivateProcs;
@@ -909,7 +975,10 @@ var
     ProcHeader: String;
   begin
     le:=SourceChangeCache.BeautifyCodeOptions.LineEnd;
-    ProcHeader:='procedure ';
+    if ResultNode=nil then
+      ProcHeader:='procedure '
+    else
+      ProcHeader:='function ';
     if ProcClassName<>'' then
       ProcHeader:=ProcHeader+ProcClassName+'.';
     ProcHeader:=ProcHeader+ProcName+ParamList+';'+le;
@@ -1002,7 +1071,7 @@ var
 begin
   Result:=false;
   {$IFDEF CTDebug}
-  DebugLn('ExtractProc A ProcName="',ProcName,'" ProcType=',ExtractProcTypeNames[ProcType]);
+  DebugLn('ExtractProc A ProcName="',ProcName,'" ProcType=',ExtractProcTypeNames[ProcType],' FunctionResultVariableStartPos=',FunctionResultVariableStartPos);
   {$ENDIF}
   if not InitExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible)
   then exit;
@@ -1014,11 +1083,12 @@ begin
     exit;
   CodeCompleteSrcChgCache:=SourceChangeCache;
 
-  VarTree:=TAVLTree.Create(TListSortCompare(@CompareExtractedProcVariables));
+  VarTree:=CreateExtractProcVariableTree;
   NewProcPath:=nil;
   try
     if not ScanNodesForVariables(StartPos,EndPos,BlockStartPos,BlockEndPos,
                                  ProcNode,VarTree,IgnoreIdentifiers,nil) then exit;
+    if not FindFunctionResultNode then exit;
     if not ReplaceSelectionWithCall then exit;
     if not DeleteMovedLocalVariables then exit;
     if not CreateProcNameParts(ProcClassName,ProcClassNode) then exit;
@@ -1038,10 +1108,7 @@ begin
     if not SourceChangeCache.Apply then exit;
     if not FindJumpPointToNewProc(NewProcPath) then exit;
   finally
-    if VarTree<>nil then begin
+    ClearExtractProcVariableTree(VarTree,true);
-      VarTree.FreeAndClear;
-      VarTree.Free;
-    end;
     NewProcPath.Free;
   end;
   Result:=true;
@@ -1076,6 +1143,7 @@ type
     end else begin
       ProcVar:=TExtractedProcVariable.Create;
       ProcVar.Node:=VarNode;
+      ProcVar.Tool:=Self;
     end;
     ProcVar.ReadInSelection:=ProcVar.ReadInSelection or IsInSelection;
     ProcVar.WriteInSelection:=ProcVar.WriteInSelection

ide/extractprocdlg.lfm

@@ -1,21 +1,20 @@
 object ExtractProcDialog: TExtractProcDialog
-  Left = 378
+  Left = 393
   Height = 355
-  Top = 374
+  Top = 446
   Width = 425
-  ActiveControl = NameEdit
+  ActiveControl = CreateFunctionCheckBox
   BorderIcons = [biSystemMenu]
   Caption = 'ExtractProcDialog'
   ClientHeight = 355
   ClientWidth = 425
   OnClose = ExtractProcDialogClose
   OnCreate = ExtractProcDialogCREATE
-  ParentFont = False
+  LCLVersion = '0.9.27'
-  LCLVersion = '0.9.25'
   object TypeRadiogroup: TRadioGroup
     AnchorSideBottom.Control = NameGroupbox
     Left = 6
-    Height = 182
+    Height = 77
     Top = 6
     Width = 413
     Align = alClient
@@ -40,8 +39,8 @@ object ExtractProcDialog: TExtractProcDialog
     AnchorSideRight.Side = asrBottom
     AnchorSideBottom.Control = CancelButton
     Left = 6
-    Height = 53
+    Height = 54
-    Top = 194
+    Top = 183
     Width = 413
     Align = alBottom
     AutoSize = True
@@ -49,7 +48,6 @@ object ExtractProcDialog: TExtractProcDialog
     Caption = 'NameGroupbox'
     ClientHeight = 35
     ClientWidth = 409
-    ParentCtl3D = False
     TabOrder = 0
     object NameEdit: TEdit
       Left = 6
@@ -63,22 +61,23 @@ object ExtractProcDialog: TExtractProcDialog
     end
   end
   object BtnPanel: TPanel
-    Height = 38
+    Left = 0
-    Top = 317
+    Height = 48
+    Top = 307
     Width = 425
     Align = alBottom
     AutoSize = True
     BevelOuter = bvNone
-    ClientHeight = 38
+    ClientHeight = 48
     ClientWidth = 425
     TabOrder = 2
     object CancelButton: TBitBtn
       AnchorSideRight.Side = asrBottom
       AnchorSideBottom.Side = asrBottom
-      Left = 344
+      Left = 341
-      Height = 26
+      Height = 36
       Top = 6
-      Width = 75
+      Width = 78
       Align = alRight
       AutoSize = True
       BorderSpacing.Around = 6
@@ -93,8 +92,8 @@ object ExtractProcDialog: TExtractProcDialog
     end
     object OkButton: TBitBtn
       AnchorSideBottom.Side = asrBottom
-      Left = 263
+      Left = 260
-      Height = 26
+      Height = 36
       Top = 6
       Width = 75
       Align = alRight
@@ -113,7 +112,7 @@ object ExtractProcDialog: TExtractProcDialog
     object HelpButton: TBitBtn
       AnchorSideBottom.Side = asrBottom
       Left = 6
-      Height = 26
+      Height = 36
       Top = 6
       Width = 75
       Align = alLeft
@@ -131,19 +130,80 @@ object ExtractProcDialog: TExtractProcDialog
   object MissingIdentifiersGroupBox: TGroupBox
     Left = 6
     Height = 58
-    Top = 253
+    Top = 243
     Width = 413
     Align = alBottom
     BorderSpacing.Around = 6
     Caption = 'MissingIdentifiersGroupBox'
-    ClientHeight = 40
+    ClientHeight = 39
     ClientWidth = 409
     TabOrder = 3
     object MissingIdentifiersListBox: TListBox
-      Height = 40
+      Left = 0
+      Height = 39
+      Top = 0
       Width = 409
       Align = alClient
+      ItemHeight = 0
       TabOrder = 0
+      TopIndex = -1
+    end
+  end
+  object FunctionGroupBox: TGroupBox
+    Left = 6
+    Height = 88
+    Top = 89
+    Width = 413
+    Align = alBottom
+    AutoSize = True
+    BorderSpacing.Around = 6
+    Caption = 'FunctionGroupBox'
+    ClientHeight = 69
+    ClientWidth = 409
+    TabOrder = 4
+    object FuncVariableLabel: TLabel
+      AnchorSideLeft.Control = CreateFunctionCheckBox
+      AnchorSideTop.Control = FuncVariableComboBox
+      AnchorSideTop.Side = asrCenter
+      Left = 6
+      Height = 18
+      Top = 39
+      Width = 115
+      Caption = 'FuncVariableLabel'
+      Enabled = False
+      ParentColor = False
+    end
+    object CreateFunctionCheckBox: TCheckBox
+      AnchorSideLeft.Control = FunctionGroupBox
+      AnchorSideTop.Control = FunctionGroupBox
+      Left = 6
+      Height = 22
+      Top = 6
+      Width = 183
+      BorderSpacing.Around = 6
+      Caption = 'CreateFunctionCheckBox'
+      OnChange = CreateFunctionCheckBoxChange
+      TabOrder = 0
+    end
+    object FuncVariableComboBox: TComboBox
+      AnchorSideLeft.Control = FuncVariableLabel
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = CreateFunctionCheckBox
+      AnchorSideTop.Side = asrBottom
+      AnchorSideRight.Control = FunctionGroupBox
+      AnchorSideRight.Side = asrBottom
+      Left = 127
+      Height = 29
+      Top = 34
+      Width = 276
+      Anchors = [akTop, akLeft, akRight]
+      AutoComplete = False
+      BorderSpacing.Around = 6
+      Enabled = False
+      ItemHeight = 0
+      ItemWidth = 0
+      TabOrder = 1
+      Text = 'FuncVariableComboBox'
     end
   end
 end

ide/extractprocdlg.lrs

@@ -1,13 +1,13 @@
 { This is an automatically generated lazarus resource file }
 
 LazarusResources.Add('TExtractProcDialog','FORMDATA',[
-  'TPF0'#18'TExtractProcDialog'#17'ExtractProcDialog'#4'Left'#3'z'#1#6'Height'#3
+  'TPF0'#18'TExtractProcDialog'#17'ExtractProcDialog'#4'Left'#3#137#1#6'Height'
-  +'c'#1#3'Top'#3'v'#1#5'Width'#3#169#1#13'ActiveControl'#7#8'NameEdit'#11'Bord'
+  +#3'c'#1#3'Top'#3#190#1#5'Width'#3#169#1#13'ActiveControl'#7#22'CreateFunctio'
-  +'erIcons'#11#12'biSystemMenu'#0#7'Caption'#6#17'ExtractProcDialog'#12'Client'
+  +'nCheckBox'#11'BorderIcons'#11#12'biSystemMenu'#0#7'Caption'#6#17'ExtractPro'
-  +'Height'#3'c'#1#11'ClientWidth'#3#169#1#7'OnClose'#7#22'ExtractProcDialogClo'
+  +'cDialog'#12'ClientHeight'#3'c'#1#11'ClientWidth'#3#169#1#7'OnClose'#7#22'Ex'
-  +'se'#8'OnCreate'#7#23'ExtractProcDialogCREATE'#10'ParentFont'#8#10'LCLVersio'
+  +'tractProcDialogClose'#8'OnCreate'#7#23'ExtractProcDialogCREATE'#10'LCLVersi'
-  +'n'#6#6'0.9.25'#0#11'TRadioGroup'#14'TypeRadiogroup'#24'AnchorSideBottom.Con'
+  +'on'#6#6'0.9.27'#0#11'TRadioGroup'#14'TypeRadiogroup'#24'AnchorSideBottom.Co'
-  +'trol'#7#12'NameGroupbox'#4'Left'#2#6#6'Height'#3#182#0#3'Top'#2#6#5'Width'#3
+  +'ntrol'#7#12'NameGroupbox'#4'Left'#2#6#6'Height'#2'M'#3'Top'#2#6#5'Width'#3
   +#157#1#5'Align'#7#8'alClient'#8'AutoFill'#9#20'BorderSpacing.Around'#2#6#7'C'
   +'aption'#6#14'TypeRadiogroup'#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildS'
   +'izing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomog'
@@ -19,32 +19,52 @@ LazarusResources.Add('TExtractProcDialog','FORMDATA',[
   +'ox'#22'AnchorSideLeft.Control'#7#5'Owner'#18'AnchorSideTop.Side'#7#9'asrBot'
   +'tom'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'as'
   +'rBottom'#24'AnchorSideBottom.Control'#7#12'CancelButton'#4'Left'#2#6#6'Heig'
-  +'ht'#2'5'#3'Top'#3#194#0#5'Width'#3#157#1#5'Align'#7#8'alBottom'#8'AutoSize'
+  +'ht'#2'6'#3'Top'#3#183#0#5'Width'#3#157#1#5'Align'#7#8'alBottom'#8'AutoSize'
   +#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#12'NameGroupbox'#12'ClientHeigh'
-  +'t'#2'#'#11'ClientWidth'#3#153#1#11'ParentCtl3D'#8#8'TabOrder'#2#0#0#5'TEdit'
+  +'t'#2'#'#11'ClientWidth'#3#153#1#8'TabOrder'#2#0#0#5'TEdit'#8'NameEdit'#4'Le'
-  +#8'NameEdit'#4'Left'#2#6#6'Height'#2#23#3'Top'#2#6#5'Width'#3#141#1#5'Align'
+  +'ft'#2#6#6'Height'#2#23#3'Top'#2#6#5'Width'#3#141#1#5'Align'#7#5'alTop'#20'B'
-  +#7#5'alTop'#20'BorderSpacing.Around'#2#6#8'TabOrder'#2#0#4'Text'#6#8'NameEdi'
+  +'orderSpacing.Around'#2#6#8'TabOrder'#2#0#4'Text'#6#8'NameEdit'#0#0#0#6'TPan'
-  +'t'#0#0#0#6'TPanel'#8'BtnPanel'#6'Height'#2'&'#3'Top'#3'='#1#5'Width'#3#169#1
+  +'el'#8'BtnPanel'#4'Left'#2#0#6'Height'#2'0'#3'Top'#3'3'#1#5'Width'#3#169#1#5
-  +#5'Align'#7#8'alBottom'#8'AutoSize'#9#10'BevelOuter'#7#6'bvNone'#12'ClientHe'
+  +'Align'#7#8'alBottom'#8'AutoSize'#9#10'BevelOuter'#7#6'bvNone'#12'ClientHeig'
-  +'ight'#2'&'#11'ClientWidth'#3#169#1#8'TabOrder'#2#2#0#7'TBitBtn'#12'CancelBu'
+  +'ht'#2'0'#11'ClientWidth'#3#169#1#8'TabOrder'#2#2#0#7'TBitBtn'#12'CancelButt'
-  +'tton'#20'AnchorSideRight.Side'#7#9'asrBottom'#21'AnchorSideBottom.Side'#7#9
+  +'on'#20'AnchorSideRight.Side'#7#9'asrBottom'#21'AnchorSideBottom.Side'#7#9'a'
-  +'asrBottom'#4'Left'#3'X'#1#6'Height'#2#26#3'Top'#2#6#5'Width'#2'K'#5'Align'#7
+  +'srBottom'#4'Left'#3'U'#1#6'Height'#2'$'#3'Top'#2#6#5'Width'#2'N'#5'Align'#7
   +#7'alRight'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#6'Cancel'#9#7'Caption'
   +#6#6'Cancel'#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#4
   +'Kind'#7#8'bkCancel'#11'ModalResult'#2#2#9'NumGlyphs'#2#0#8'TabOrder'#2#0#0#0
-  +#7'TBitBtn'#8'OkButton'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3#7
+  +#7'TBitBtn'#8'OkButton'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3#4
-  +#1#6'Height'#2#26#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#7'alRight'#8'AutoSize'
+  +#1#6'Height'#2'$'#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#7'alRight'#8'AutoSize'
   +#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#3'&OK'#21'Constraints.MinHeight'
   +#2#25#20'Constraints.MinWidth'#2'K'#7'Default'#9#4'Kind'#7#4'bkOK'#11'ModalR'
   +'esult'#2#1#9'NumGlyphs'#2#0#7'OnClick'#7#13'OkButtonCLICK'#8'TabOrder'#2#1#0
   +#0#7'TBitBtn'#10'HelpButton'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'
-  +#2#6#6'Height'#2#26#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#6'alLeft'#8'AutoSize'
+  +#2#6#6'Height'#2'$'#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#6'alLeft'#8'AutoSize'
   +#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#5'&Help'#21'Constraints.MinHeig'
   +'ht'#2#25#20'Constraints.MinWidth'#2'K'#4'Kind'#7#6'bkHelp'#9'NumGlyphs'#2#0
   +#7'OnClick'#7#15'HelpButtonClick'#8'TabOrder'#2#2#0#0#0#9'TGroupBox'#26'Miss'
-  +'ingIdentifiersGroupBox'#4'Left'#2#6#6'Height'#2':'#3'Top'#3#253#0#5'Width'#3
+  +'ingIdentifiersGroupBox'#4'Left'#2#6#6'Height'#2':'#3'Top'#3#243#0#5'Width'#3
   +#157#1#5'Align'#7#8'alBottom'#20'BorderSpacing.Around'#2#6#7'Caption'#6#26'M'
-  +'issingIdentifiersGroupBox'#12'ClientHeight'#2'('#11'ClientWidth'#3#153#1#8
+  +'issingIdentifiersGroupBox'#12'ClientHeight'#2''''#11'ClientWidth'#3#153#1#8
-  +'TabOrder'#2#3#0#8'TListBox'#25'MissingIdentifiersListBox'#6'Height'#2'('#5
+  +'TabOrder'#2#3#0#8'TListBox'#25'MissingIdentifiersListBox'#4'Left'#2#0#6'Hei'
-  +'Width'#3#153#1#5'Align'#7#8'alClient'#8'TabOrder'#2#0#0#0#0#0
+  +'ght'#2''''#3'Top'#2#0#5'Width'#3#153#1#5'Align'#7#8'alClient'#10'ItemHeight'
+  +#2#0#8'TabOrder'#2#0#8'TopIndex'#2#255#0#0#0#9'TGroupBox'#16'FunctionGroupBo'
+  +'x'#4'Left'#2#6#6'Height'#2'X'#3'Top'#2'Y'#5'Width'#3#157#1#5'Align'#7#8'alB'
+  +'ottom'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#16'FunctionG'
+  +'roupBox'#12'ClientHeight'#2'E'#11'ClientWidth'#3#153#1#8'TabOrder'#2#4#0#6
+  +'TLabel'#17'FuncVariableLabel'#22'AnchorSideLeft.Control'#7#22'CreateFunctio'
+  +'nCheckBox'#21'AnchorSideTop.Control'#7#20'FuncVariableComboBox'#18'AnchorSi'
+  +'deTop.Side'#7#9'asrCenter'#4'Left'#2#6#6'Height'#2#18#3'Top'#2''''#5'Width'
+  +#2's'#7'Caption'#6#17'FuncVariableLabel'#7'Enabled'#8#11'ParentColor'#8#0#0#9
+  +'TCheckBox'#22'CreateFunctionCheckBox'#22'AnchorSideLeft.Control'#7#16'Funct'
+  +'ionGroupBox'#21'AnchorSideTop.Control'#7#16'FunctionGroupBox'#4'Left'#2#6#6
+  +'Height'#2#22#3'Top'#2#6#5'Width'#3#183#0#20'BorderSpacing.Around'#2#6#7'Cap'
+  +'tion'#6#22'CreateFunctionCheckBox'#8'OnChange'#7#28'CreateFunctionCheckBoxC'
+  +'hange'#8'TabOrder'#2#0#0#0#9'TComboBox'#20'FuncVariableComboBox'#22'AnchorS'
+  +'ideLeft.Control'#7#17'FuncVariableLabel'#19'AnchorSideLeft.Side'#7#9'asrBot'
+  +'tom'#21'AnchorSideTop.Control'#7#22'CreateFunctionCheckBox'#18'AnchorSideTo'
+  +'p.Side'#7#9'asrBottom'#23'AnchorSideRight.Control'#7#16'FunctionGroupBox'#20
+  +'AnchorSideRight.Side'#7#9'asrBottom'#4'Left'#2''#6'Height'#2#29#3'Top'#2'"'
+  +#5'Width'#3#20#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#12'AutoComple'
+  ,'te'#8#20'BorderSpacing.Around'#2#6#7'Enabled'#8#10'ItemHeight'#2#0#9'ItemWi'
+  +'dth'#2#0#8'TabOrder'#2#1#4'Text'#6#20'FuncVariableComboBox'#0#0#0#0
 ]);

ide/extractprocdlg.pas

@@ -22,8 +22,8 @@
 
   Abstract:
     Dialog for the Extract Proc feature.
-    Allows user choose what kind of procedure to create and shows missing
+    Allows user choose what kind of procedure/function to create and
-    identifiers.
+    shows missing identifiers.
 }
 unit ExtractProcDlg;
 
@@ -32,9 +32,10 @@ unit ExtractProcDlg;
 interface
 
 uses
-  Classes, SysUtils, AVL_Tree, LResources, Forms, Controls, Graphics, Dialogs,
+  Classes, SysUtils, LCLProc, AVL_Tree, LResources, Forms, Controls, Graphics,
-  ExtCtrls, Buttons, StdCtrls,
+  Dialogs, ExtCtrls, Buttons, StdCtrls,
-  BasicCodeTools, CodeAtom, CodeCache, CodeToolManager, ExtractProcTool,
+  BasicCodeTools, CodeTree, CodeAtom, CodeCache, CodeToolManager,
+  ExtractProcTool,
   LazarusIDEStrConsts, IDEProcs, MiscOptions, IDEContextHelpEdit;
 
 type
@@ -42,38 +43,50 @@ type
   { TExtractProcDialog }
 
   TExtractProcDialog = class(TForm)
+    FuncVariableComboBox: TComboBox;
+    CreateFunctionCheckBox: TCheckBox;
+    FunctionGroupBox: TGroupBox;
+    FuncVariableLabel: TLabel;
     MissingIdentifiersListBox: TListBox;
     MissingIdentifiersGroupBox: TGroupBox;
-    NameEdit: TEDIT;
+    NameEdit: TEdit;
-    NameGroupbox: TGROUPBOX;
+    NameGroupbox: TGroupBox;
     OkButton: TBitBtn;
     CancelButton: TBitBtn;
     HelpButton: TBitBtn;
     BtnPanel: TPanel;
-    TypeRadiogroup: TRADIOGROUP;
+    TypeRadiogroup: TRadioGroup;
+    procedure CreateFunctionCheckBoxChange(Sender: TObject);
     procedure HelpButtonClick(Sender: TObject);
-    procedure ExtractProcDialogCREATE(Sender: TObject);
+    procedure ExtractProcDialogCreate(Sender: TObject);
     procedure ExtractProcDialogClose(Sender: TObject;
       var CloseAction: TCloseAction);
-    procedure OkButtonCLICK(Sender: TObject);
+    procedure OkButtonClick(Sender: TObject);
   private
     FMethodPossible: boolean;
     FMissingIdentifiers: TAVLTree;
     FSubProcSameLvlPossible: boolean;
+    FVariables: TAVLTree;
     procedure SetMissingIdentifiers(const AValue: TAVLTree);
+    procedure SetVariables(const AValue: TAVLTree);
+    function VarNodeToStr(Variable: TExtractedProcVariable): string;
   public
     procedure UpdateAvailableTypes;
+    procedure UpdateFunction;
     function GetProcType: TExtractProcType;
     function GetProcName: string;
+    function GetFunctionNode: TCodeTreeNode;
+
     property MethodPossible: boolean read FMethodPossible write FMethodPossible;
     property SubProcSameLvlPossible: boolean read FSubProcSameLvlPossible write FSubProcSameLvlPossible;
     property MissingIdentifiers: TAVLTree read FMissingIdentifiers write SetMissingIdentifiers;
+    property Variables: TAVLTree read FVariables write SetVariables;// tree of TExtractedProcVariable
   end;
 
 function ShowExtractProcDialog(Code: TCodeBuffer;
   const BlockBegin, BlockEnd: TPoint;
   var NewSource: TCodeBuffer;
-  var NewX, NewY, NewTopLine: integer): TModalresult;
+  var NewX, NewY, NewTopLine: integer): TModalResult;
 
 implementation
 
@@ -88,6 +101,9 @@ var
   ProcName: String;
   ProcType: TExtractProcType;
   MissingIdentifiers: TAVLTree;
+  VarTree: TAVLTree;
+  FuncNode: TCodeTreeNode;
+  FunctionResultVariableStartPos: Integer;
 begin
   Result:=mrCancel;
   if CompareCaret(BlockBegin,BlockEnd)<=0 then begin
@@ -98,10 +114,12 @@ begin
   end;
   
   MissingIdentifiers:=nil;
+  VarTree:=nil;
   try
+    VarTree:=CreateExtractProcVariableTree;
     // check if selected statements can be extracted
     if not CodeToolBoss.CheckExtractProc(Code,BlockBegin,BlockEnd,MethodPossible,
-      SubProcSameLvlPossible,MissingIdentifiers)
+      SubProcSameLvlPossible,MissingIdentifiers,VarTree)
     then begin
       if CodeToolBoss.ErrorMessage='' then begin
         MessageDlg(lisInvalidSelection,
@@ -118,36 +136,47 @@ begin
       ExtractProcDialog.SubProcSameLvlPossible:=SubProcSameLvlPossible;
       ExtractProcDialog.MissingIdentifiers:=MissingIdentifiers;
       ExtractProcDialog.UpdateAvailableTypes;
+      ExtractProcDialog.Variables:=VarTree;
       Result:=ExtractProcDialog.ShowModal;
       if Result<>mrOk then exit;
       ProcName:=ExtractProcDialog.GetProcName;
       ProcType:=ExtractProcDialog.GetProcType;
+      FuncNode:=ExtractProcDialog.GetFunctionNode;
+      FunctionResultVariableStartPos:=0;
+      if FuncNode<>nil then
+        FunctionResultVariableStartPos:=FuncNode.StartPos;
     finally
       ExtractProcDialog.Free;
     end;
 
     // extract procedure/method
     if not CodeToolBoss.ExtractProc(Code,BlockBegin,BlockEnd,ProcType,ProcName,
-      MissingIdentifiers,NewSource,NewX,NewY,NewTopLine)
+      MissingIdentifiers,NewSource,NewX,NewY,NewTopLine,
+      FunctionResultVariableStartPos)
     then begin
       Result:=mrCancel;
       exit;
     end;
     Result:=mrOk;
   finally
+    ClearExtractProcVariableTree(VarTree,true);
     CodeToolBoss.FreeTreeOfPCodeXYPosition(MissingIdentifiers);
   end;
 end;
 
 { TExtractProcDialog }
 
-procedure TExtractProcDialog.ExtractProcDialogCREATE(Sender: TObject);
+procedure TExtractProcDialog.ExtractProcDialogCreate(Sender: TObject);
 begin
   Caption:=lisExtractProcedure;
   NameGroupbox.Caption:=lisNameOfNewProcedure;
   TypeRadiogroup.Caption:=dlgEnvType;
   NameEdit.Text:=MiscellaneousOptions.ExtractProcName;
   MissingIdentifiersGroupBox.Caption:=lisMissingIdentifiers;
+
+  FunctionGroupBox.Caption:=lisFunction;
+  CreateFunctionCheckBox.Caption:=lisCreateFunction;
+  FuncVariableLabel.Caption:=lisResult2;
   
   HelpButton.Caption:=lisPckEditHelp;
   OkButton.Caption:=lisExtract;
@@ -162,13 +191,19 @@ begin
   ShowContextHelpForIDE(Self);
 end;
 
+procedure TExtractProcDialog.CreateFunctionCheckBoxChange(Sender: TObject);
+begin
+  FuncVariableComboBox.Enabled:=CreateFunctionCheckBox.Checked;
+  FuncVariableLabel.Enabled:=FuncVariableComboBox.Enabled;
+end;
+
 procedure TExtractProcDialog.ExtractProcDialogClose(Sender: TObject;
   var CloseAction: TCloseAction);
 begin
   MiscellaneousOptions.ExtractProcName:=NameEdit.Text;
 end;
 
-procedure TExtractProcDialog.OkButtonCLICK(Sender: TObject);
+procedure TExtractProcDialog.OkButtonClick(Sender: TObject);
 var
   ProcName: String;
 begin
@@ -214,6 +249,23 @@ begin
   MissingIdentifiersGroupBox.Visible:=MissingIdentifiersListBox.Items.Count>0;
 end;
 
+procedure TExtractProcDialog.SetVariables(const AValue: TAVLTree);
+begin
+  if FVariables=AValue then exit;
+  FVariables:=AValue;
+  UpdateFunction;
+end;
+
+function TExtractProcDialog.VarNodeToStr(Variable: TExtractedProcVariable
+  ): string;
+begin
+  if Variable.Node.Desc=ctnVarDefinition then
+    Result:=Variable.Tool.ExtractDefinitionName(Variable.Node)
+            +' : '+Variable.Tool.ExtractDefinitionNodeType(Variable.Node)
+  else
+    Result:='';
+end;
+
 procedure TExtractProcDialog.UpdateAvailableTypes;
 begin
   with TypeRadiogroup.Items do begin
@@ -238,6 +290,43 @@ begin
   end;
 end;
 
+procedure TExtractProcDialog.UpdateFunction;
+var
+  AVLNode: TAVLTreeNode;
+  Variable: TExtractedProcVariable;
+  sl: TStringList;
+begin
+  FuncVariableComboBox.Items.BeginUpdate;
+  FuncVariableComboBox.Items.Clear;
+  if Variables<>nil then begin
+    sl:=TStringList.Create;
+    try
+      AVLNode:=Variables.FindLowest;
+      while AVLNode<>nil do begin
+        Variable:=TExtractedProcVariable(AVLNode.Data);
+        if Variable.WriteInSelection then begin
+          //DebugLn(['TExtractProcDialog.UpdateFunction ',Variable.Node.DescAsString]);
+          if Variable.Node.Desc=ctnVarDefinition then begin
+            sl.Add(VarNodeToStr(Variable));
+          end;
+        end;
+        AVLNode:=Variables.FindSuccessor(AVLNode);
+      end;
+      sl.Sort;
+      FuncVariableComboBox.Items.Assign(sl);
+      if FuncVariableComboBox.Items.Count>0 then
+        FuncVariableComboBox.Text:=FuncVariableComboBox.Items[0];
+      FuncVariableComboBox.ItemIndex:=0;
+    finally
+      sl.Free;
+    end;
+  end;
+  FuncVariableComboBox.Items.EndUpdate;
+  FuncVariableComboBox.Enabled:=CreateFunctionCheckBox.Checked;
+  FuncVariableLabel.Enabled:=FuncVariableComboBox.Enabled;
+  FunctionGroupBox.Visible:=FuncVariableComboBox.Items.Count>0;
+end;
+
 function TExtractProcDialog.GetProcType: TExtractProcType;
 var
   Item: string;
@@ -261,6 +350,33 @@ begin
   Result:=NameEdit.Text;
 end;
 
+function TExtractProcDialog.GetFunctionNode: TCodeTreeNode;
+var
+  AVLNode: TAVLTreeNode;
+  s: String;
+  Find: String;
+  Variable: TExtractedProcVariable;
+begin
+  Result:=nil;
+  if Variables=nil then exit;
+  Find:=FuncVariableComboBox.Text;
+  AVLNode:=Variables.FindLowest;
+  while AVLNode<>nil do begin
+    Variable:=TExtractedProcVariable(AVLNode.Data);
+    if Variable.WriteInSelection then begin
+      //DebugLn(['TExtractProcDialog.UpdateFunction ',Variable.Node.DescAsString]);
+      if Variable.Node.Desc=ctnVarDefinition then begin
+        s:=VarNodeToStr(Variable);
+        if s=Find then begin
+          Result:=Variable.Node;
+          exit;
+        end;
+      end;
+    end;
+    AVLNode:=Variables.FindSuccessor(AVLNode);
+  end;
+end;
+
 initialization
   {$I extractprocdlg.lrs}
 

ide/lazarusidestrconsts.pas

@@ -4072,6 +4072,8 @@ resourcestring
     +'with the name %s%s%s.';  
   lisDuplicateFoundOfValue = 'Duplicate found of value %s%s%s.';  
   lisSetValue = 'Set value';
+  lisCreateFunction = 'Create function';
+  lisResult2 = 'Result:';
 
 implementation