paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 10:59:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: extractproc for program

Browse Source 
git-svn-id: trunk@30533 -
This commit is contained in:
mattias 2011-05-02 18:27:16 +00:00
parent 515fc71d92
commit a031fab2fc
4 changed files with 122 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
components/codetools/codetoolmanager.pas
View File

@ -542,7 +542,7 @@ type
// extract proc (creates a new procedure from code in selection) // extract proc (creates a new procedure from code in selection)
function CheckExtractProc(Code: TCodeBuffer; function CheckExtractProc(Code: TCodeBuffer;
const StartPoint, EndPoint: TPoint; const StartPoint, EndPoint: TPoint;
out MethodPossible, SubProcSameLvlPossible: boolean; out MethodPossible, SubProcPossible, SubProcSameLvlPossible: boolean;
out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition
VarTree: TAVLTree = nil // tree of TExtractedProcVariable VarTree: TAVLTree = nil // tree of TExtractedProcVariable
): boolean; ): boolean;
@ -3880,10 +3880,9 @@ begin
end; end;
function TCodeToolManager.CheckExtractProc(Code: TCodeBuffer; const StartPoint, function TCodeToolManager.CheckExtractProc(Code: TCodeBuffer; const StartPoint,
EndPoint: TPoint; out MethodPossible, SubProcSameLvlPossible: boolean; EndPoint: TPoint; out MethodPossible, SubProcPossible,
out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition SubProcSameLvlPossible: boolean; out MissingIdentifiers: TAVLTree;
VarTree: TAVLTree // tree of TExtractedProcVariable VarTree: TAVLTree): boolean;
): boolean;
var var
StartPos, EndPos: TCodeXYPosition; StartPos, EndPos: TCodeXYPosition;
begin begin
@ -3900,8 +3899,8 @@ begin
EndPos.Code:=Code; EndPos.Code:=Code;
try try
Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible, Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible,
SubProcSameLvlPossible,MissingIdentifiers, SubProcPossible,SubProcSameLvlPossible,MissingIdentifiers,
VarTree); VarTree);
except except
on e: Exception do Result:=HandleException(e); on e: Exception do Result:=HandleException(e);
end; end;

97
components/codetools/extractproctool.pas
View File

@ -37,7 +37,7 @@ unit ExtractProcTool;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{off $define CTDEBUG} {$define CTDEBUG}
interface interface
@ -86,16 +86,16 @@ type
protected protected
function ScanNodesForVariables(const StartPos, EndPos: TCodeXYPosition; function ScanNodesForVariables(const StartPos, EndPos: TCodeXYPosition;
out BlockStartPos, BlockEndPos: integer; // the selection out BlockStartPos, BlockEndPos: integer; // the selection
out ProcNode: TCodeTreeNode; out BlockNode: TCodeTreeNode;
VarTree: TAVLTree; // tree of TExtractedProcVariable VarTree: TAVLTree; // tree of TExtractedProcVariable
IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
MissingIdentifiers: TAVLTree // tree of PCodeXYPosition MissingIdentifiers: TAVLTree // tree of PCodeXYPosition
): boolean; ): boolean;
function InitExtractProc(const StartPos, EndPos: TCodeXYPosition; function InitExtractProc(const StartPos, EndPos: TCodeXYPosition;
out MethodPossible, SubProcSameLvlPossible: boolean): boolean; out MethodPossible, SubProcPossible, SubProcSameLvlPossible: boolean): boolean;
public public
function CheckExtractProc(const StartPos, EndPos: TCodeXYPosition; function CheckExtractProc(const StartPos, EndPos: TCodeXYPosition;
out MethodPossible, SubProcSameLvlPossible: boolean; out MethodPossible, SubProcPossible, SubProcSameLvlPossible: boolean;
out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition
VarTree: TAVLTree = nil // tree of TExtractedProcVariable VarTree: TAVLTree = nil // tree of TExtractedProcVariable
): boolean; ): boolean;
@ -176,8 +176,8 @@ end;
{ TExtractProcTool } { TExtractProcTool }
function TExtractProcTool.InitExtractProc(const StartPos, function TExtractProcTool.InitExtractProc(const StartPos,
EndPos: TCodeXYPosition; EndPos: TCodeXYPosition; out MethodPossible, SubProcPossible,
out MethodPossible, SubProcSameLvlPossible: boolean): boolean; SubProcSameLvlPossible: boolean): boolean;
var var
CleanStartPos, CleanEndPos: integer; CleanStartPos, CleanEndPos: integer;
CursorNode: TCodeTreeNode; CursorNode: TCodeTreeNode;
@ -189,6 +189,7 @@ var
begin begin
Result:=false; Result:=false;
MethodPossible:=false; MethodPossible:=false;
SubProcPossible:=false;
SubProcSameLvlPossible:=false; SubProcSameLvlPossible:=false;
{$IFDEF CTDebug} {$IFDEF CTDebug}
DebugLn('TExtractProcTool.InitExtractProc syntax and cursor check ..'); DebugLn('TExtractProcTool.InitExtractProc syntax and cursor check ..');
@ -275,6 +276,7 @@ begin
ProcLvl:=0; ProcLvl:=0;
while ANode<>nil do begin while ANode<>nil do begin
if (ANode.Desc=ctnProcedure) then begin if (ANode.Desc=ctnProcedure) then begin
SubProcPossible:=true;
inc(ProcLvl); inc(ProcLvl);
if NodeIsInAMethod(ANode) then begin if NodeIsInAMethod(ANode) then begin
MethodPossible:=true; MethodPossible:=true;
@ -290,8 +292,9 @@ begin
end; end;
function TExtractProcTool.CheckExtractProc(const StartPos, function TExtractProcTool.CheckExtractProc(const StartPos,
EndPos: TCodeXYPosition; out MethodPossible, SubProcSameLvlPossible: boolean; EndPos: TCodeXYPosition; out MethodPossible, SubProcPossible,
out MissingIdentifiers: TAVLTree; VarTree: TAVLTree): boolean; SubProcSameLvlPossible: boolean; out MissingIdentifiers: TAVLTree;
VarTree: TAVLTree): boolean;
var var
BlockStartPos: integer; BlockStartPos: integer;
BlockEndPos: integer; BlockEndPos: integer;
@ -301,7 +304,8 @@ begin
MissingIdentifiers:=nil; MissingIdentifiers:=nil;
ActivateGlobalWriteLock; ActivateGlobalWriteLock;
try try
if not InitExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible) if not InitExtractProc(StartPos,EndPos,MethodPossible,
SubProcPossible,SubProcSameLvlPossible)
then exit; then exit;
MissingIdentifiers:=CreateTreeOfPCodeXYPosition; MissingIdentifiers:=CreateTreeOfPCodeXYPosition;
if not ScanNodesForVariables(StartPos,EndPos,BlockStartPos,BlockEndPos, if not ScanNodesForVariables(StartPos,EndPos,BlockStartPos,BlockEndPos,
@ -322,7 +326,7 @@ const
ShortProcFormat = [phpWithoutClassKeyword]; ShortProcFormat = [phpWithoutClassKeyword];
var var
BlockStartPos, BlockEndPos: integer; // the selection BlockStartPos, BlockEndPos: integer; // the selection
ProcNode: TCodeTreeNode; // the main proc node of the selection MainBlockNode: TCodeTreeNode; // the main proc node of the selection, or main begin block of program
VarTree: TAVLTree; VarTree: TAVLTree;
ResultNode: TCodeTreeNode; ResultNode: TCodeTreeNode;
@ -599,11 +603,21 @@ var
{$IFDEF CTDebug} {$IFDEF CTDebug}
DebugLn('CreateProcNameParts A searching class name ..'); DebugLn('CreateProcNameParts A searching class name ..');
{$ENDIF} {$ENDIF}
ProcClassName:=ExtractClassNameOfProcNode(ProcNode); if (MainBlockNode=nil) or (MainBlockNode.Desc<>ctnProcedure) then begin
if ProcClassName='' then exit; debugln(['CreateProcNameParts not in a procedure']);
exit;
end;
ProcClassName:=ExtractClassNameOfProcNode(MainBlockNode);
if ProcClassName='' then begin
debugln(['CreateProcNameParts not in a method']);
exit;
end;
ProcClassNode:=FindClassNodeInUnit(ProcClassName, ProcClassNode:=FindClassNodeInUnit(ProcClassName,
true,false,false,true); true,false,false,true);
if ProcClassNode=nil then exit; if ProcClassNode=nil then begin
debugln(['CreateProcNameParts class not found ',ProcClassName]);
exit;
end;
ProcClassName:=ExtractClassName(ProcClassNode,false); ProcClassName:=ExtractClassName(ProcClassNode,false);
end; end;
{$IFDEF CTDebug} {$IFDEF CTDebug}
@ -794,7 +808,11 @@ var
eptSubProcedure: eptSubProcedure:
begin begin
BeginNode:=ProcNode.LastChild; if MainBlockNode.Desc<>ctnProcedure then begin
debugln(['FindInsertPositionForProcBody subprocedure: not in a procedure']);
exit;
end;
BeginNode:=MainBlockNode.LastChild;
while BeginNode.Desc<>ctnBeginBlock do while BeginNode.Desc<>ctnBeginBlock do
BeginNode:=BeginNode.PriorBrother; BeginNode:=BeginNode.PriorBrother;
InsertPos:=BeginNode.StartPos; InsertPos:=BeginNode.StartPos;
@ -805,14 +823,14 @@ var
eptSubProcedureSameLvl: eptSubProcedureSameLvl:
begin begin
// -> insert in front of old proc // -> insert in front of old proc
InsertPos:=FindLineEndOrCodeInFrontOfPosition(ProcNode.StartPos); InsertPos:=FindLineEndOrCodeInFrontOfPosition(MainBlockNode.StartPos);
Indent:=GetLineIndent(Src,ProcNode.StartPos); Indent:=GetLineIndent(Src,MainBlockNode.StartPos);
end; end;
eptProcedure,eptProcedureWithInterface: eptProcedure,eptProcedureWithInterface:
begin begin
// insert in front of top level proc // insert in front of top level proc
InsertNode:=ProcNode; InsertNode:=MainBlockNode;
ANode:=InsertNode; ANode:=InsertNode;
while (ANode<>nil) do begin while (ANode<>nil) do begin
if ANode.Desc=ctnProcedure then if ANode.Desc=ctnProcedure then
@ -843,8 +861,8 @@ var
eptPublishedMethod,eptPrivateMethod,eptProtectedMethod,eptPublicMethod: eptPublishedMethod,eptPrivateMethod,eptProtectedMethod,eptPublicMethod:
begin begin
// set default values // set default values
InsertPos:=FindLineEndOrCodeInFrontOfPosition(ProcNode.StartPos); InsertPos:=FindLineEndOrCodeInFrontOfPosition(MainBlockNode.StartPos);
Indent:=GetLineIndent(Src,ProcNode.StartPos); Indent:=GetLineIndent(Src,MainBlockNode.StartPos);
end; end;
else else
@ -1070,17 +1088,22 @@ var
NewProcPath: TStrings; NewProcPath: TStrings;
ProcClassNode: TCodeTreeNode; ProcClassNode: TCodeTreeNode;
ProcCode: string; ProcCode: string;
SubProcPossible: boolean;
begin begin
Result:=false; Result:=false;
{$IFDEF CTDebug} {$IFDEF CTDebug}
DebugLn(['ExtractProc A ProcName="',ProcName,'" ProcType=',ExtractProcTypeNames[ProcType],' FunctionResultVariableStartPos=',FunctionResultVariableStartPos]); DebugLn(['ExtractProc A ProcName="',ProcName,'" ProcType=',ExtractProcTypeNames[ProcType],' FunctionResultVariableStartPos=',FunctionResultVariableStartPos]);
{$ENDIF} {$ENDIF}
if not InitExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible) if not InitExtractProc(StartPos,EndPos,MethodPossible,
SubProcPossible,SubProcSameLvlPossible)
then exit; then exit;
if (not MethodPossible) and (ProcType in [eptPrivateMethod,eptProtectedMethod, if (not MethodPossible) and (ProcType in [eptPrivateMethod,eptProtectedMethod,
eptPublicMethod,eptPublishedMethod]) eptPublicMethod,eptPublishedMethod])
then then
exit; exit;
if (not SubProcPossible)
and (ProcType in [eptSubProcedure,eptSubProcedureSameLvl]) then
exit;
if (not SubProcSameLvlPossible) and (ProcType=eptSubProcedureSameLvl) then if (not SubProcSameLvlPossible) and (ProcType=eptSubProcedureSameLvl) then
exit; exit;
CodeCompleteSrcChgCache:=SourceChangeCache; CodeCompleteSrcChgCache:=SourceChangeCache;
@ -1089,7 +1112,7 @@ begin
NewProcPath:=nil; NewProcPath:=nil;
try try
if not ScanNodesForVariables(StartPos,EndPos,BlockStartPos,BlockEndPos, if not ScanNodesForVariables(StartPos,EndPos,BlockStartPos,BlockEndPos,
ProcNode,VarTree,IgnoreIdentifiers,nil) then exit; MainBlockNode,VarTree,IgnoreIdentifiers,nil) then exit;
if not FindFunctionResultNode then exit; if not FindFunctionResultNode then exit;
if not ReplaceSelectionWithCall then exit; if not ReplaceSelectionWithCall then exit;
if not DeleteMovedLocalVariables then exit; if not DeleteMovedLocalVariables then exit;
@ -1123,7 +1146,7 @@ end;
function TExtractProcTool.ScanNodesForVariables(const StartPos, function TExtractProcTool.ScanNodesForVariables(const StartPos,
EndPos: TCodeXYPosition; out BlockStartPos, BlockEndPos: integer; EndPos: TCodeXYPosition; out BlockStartPos, BlockEndPos: integer;
out ProcNode: TCodeTreeNode; out BlockNode: TCodeTreeNode;
VarTree: TAVLTree; // tree of TExtractedProcVariable VarTree: TAVLTree; // tree of TExtractedProcVariable
IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
MissingIdentifiers: TAVLTree// tree of PCodeXYPosition MissingIdentifiers: TAVLTree// tree of PCodeXYPosition
@ -1279,11 +1302,11 @@ var
if (Params.NewCodeTool=Self) and (Params.NewNode<>nil) then begin if (Params.NewCodeTool=Self) and (Params.NewNode<>nil) then begin
VarNode:=Params.NewNode; VarNode:=Params.NewNode;
if (VarNode.Desc=ctnVarDefinition) if (VarNode.Desc=ctnVarDefinition)
and (VarNode.HasAsParent(ProcNode)) then begin and (VarNode.HasAsParent(BlockNode)) then begin
// Now we know: VarNode is a variable defined in the main proc // Now we know: VarNode is a variable defined in the main proc
// or one of its sub procs // or one of its sub procs
ClosestProcNode:=VarNode.GetNodeOfType(ctnProcedure); ClosestProcNode:=VarNode.GetNodeOfType(ctnProcedure);
if ClosestProcNode=ProcNode then begin if ClosestProcNode=BlockNode then begin
// VarNode is a variable defined by the main proc // VarNode is a variable defined by the main proc
IsParameter:=VarNode.GetNodeOfType(ctnProcedureHead)<>nil; IsParameter:=VarNode.GetNodeOfType(ctnProcedureHead)<>nil;
ParameterType:=ptNone; ParameterType:=ptNone;
@ -1350,12 +1373,11 @@ var
Result:=false; Result:=false;
ChildNode:=StartNode.FirstChild; ChildNode:=StartNode.FirstChild;
while ChildNode<>nil do begin while ChildNode<>nil do begin
if (ChildNode.Desc in [ctnBeginBlock,ctnAsmBlock]) if (ChildNode.Desc in [ctnBeginBlock,ctnAsmBlock]) then begin
and (ChildNode.Parent.Desc=ctnProcedure) then begin
if not ScanSourceForVariables(ChildNode.StartPos,ChildNode.EndPos) then if not ScanSourceForVariables(ChildNode.StartPos,ChildNode.EndPos) then
exit; exit;
end; end else if not ScanNodesForVariablesRecursive(ChildNode) then
if not ScanNodesForVariablesRecursive(ChildNode) then exit; exit;
ChildNode:=ChildNode.NextBrother; ChildNode:=ChildNode.NextBrother;
end; end;
Result:=true; Result:=true;
@ -1369,12 +1391,25 @@ begin
if CaretToCleanPos(StartPos,BlockStartPos)<>0 then exit; if CaretToCleanPos(StartPos,BlockStartPos)<>0 then exit;
if CaretToCleanPos(EndPos,BlockEndPos)<>0 then exit; if CaretToCleanPos(EndPos,BlockEndPos)<>0 then exit;
BuildSubTree(BlockStartPos); BuildSubTree(BlockStartPos);
ProcNode:=FindDeepestNodeAtPos(BlockStartPos,true).GetNodeOfType(ctnProcedure); BlockNode:=FindDeepestNodeAtPos(BlockStartPos,true);
while BlockNode<>nil do begin
if BlockNode.Desc in [ctnInitialization,ctnFinalization,ctnProcedure]
then break;
if (BlockNode.Desc=ctnBeginBlock)
and (BlockNode.Parent.Desc in AllSourceTypes) then
break;
BlockNode:=BlockNode.Parent;
end;
if BlockNode=nil then begin
debugln(['TExtractProcTool.ScanNodesForVariables invalid context ',FindDeepestNodeAtPos(BlockStartPos,false).DescAsString]);
exit;
end;
// collect local variables to speed up search // collect local variables to speed up search
ScanForLocalVariables(ProcNode); ScanForLocalVariables(BlockNode);
if not ScanNodesForVariablesRecursive(ProcNode) then exit; if not ScanNodesForVariablesRecursive(BlockNode) then exit;
finally finally
VarCandidates.Free; VarCandidates.Free;
DeactivateGlobalWriteLock; DeactivateGlobalWriteLock;

78
ide/extractprocdlg.lfm
View File

@ -1,7 +1,7 @@
object ExtractProcDialog: TExtractProcDialog object ExtractProcDialog: TExtractProcDialog
Left = 393 Left = 374
Height = 355 Height = 355
Top = 446 Top = 360
Width = 425 Width = 425
ActiveControl = CreateFunctionCheckBox ActiveControl = CreateFunctionCheckBox
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
@ -11,15 +11,17 @@ object ExtractProcDialog: TExtractProcDialog
ClientWidth = 425 ClientWidth = 425
OnClose = ExtractProcDialogClose OnClose = ExtractProcDialogClose
OnCreate = ExtractProcDialogCREATE OnCreate = ExtractProcDialogCREATE
LCLVersion = '0.9.29' Position = poScreenCenter
LCLVersion = '0.9.31'
object TypeRadiogroup: TRadioGroup object TypeRadiogroup: TRadioGroup
AnchorSideBottom.Control = NameGroupbox AnchorSideBottom.Control = NameGroupbox
Left = 6 Left = 6
Height = 98 Height = 95
Top = 6 Top = 6
Width = 413 Width = 413
Align = alClient Align = alClient
AutoFill = True AutoFill = True
AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'TypeRadiogroup' Caption = 'TypeRadiogroup'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
@ -39,21 +41,21 @@ object ExtractProcDialog: TExtractProcDialog
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideBottom.Control = CancelButton AnchorSideBottom.Control = CancelButton
Left = 6 Left = 6
Height = 53 Height = 56
Top = 194 Top = 192
Width = 413 Width = 413
Align = alBottom Align = alBottom
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'NameGroupbox' Caption = 'NameGroupbox'
ClientHeight = 35 ClientHeight = 34
ClientWidth = 409 ClientWidth = 405
TabOrder = 0 TabOrder = 0
object NameEdit: TEdit object NameEdit: TEdit
Left = 6 Left = 6
Height = 23 Height = 22
Top = 6 Top = 6
Width = 397 Width = 393
Align = alTop Align = alTop
BorderSpacing.Around = 6 BorderSpacing.Around = 6
TabOrder = 0 TabOrder = 0
@ -62,20 +64,20 @@ object ExtractProcDialog: TExtractProcDialog
end end
object BtnPanel: TPanel object BtnPanel: TPanel
Left = 0 Left = 0
Height = 38 Height = 37
Top = 317 Top = 318
Width = 425 Width = 425
Align = alBottom Align = alBottom
AutoSize = True AutoSize = True
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 38 ClientHeight = 37
ClientWidth = 425 ClientWidth = 425
TabOrder = 2 TabOrder = 2
object CancelButton: TBitBtn object CancelButton: TBitBtn
Left = 338 Left = 344
Height = 26 Height = 25
Top = 6 Top = 6
Width = 81 Width = 75
Align = alRight Align = alRight
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
@ -89,8 +91,8 @@ object ExtractProcDialog: TExtractProcDialog
TabOrder = 0 TabOrder = 0
end end
object OkButton: TBitBtn object OkButton: TBitBtn
Left = 257 Left = 263
Height = 26 Height = 25
Top = 6 Top = 6
Width = 75 Width = 75
Align = alRight Align = alRight
@ -108,7 +110,7 @@ object ExtractProcDialog: TExtractProcDialog
end end
object HelpButton: TBitBtn object HelpButton: TBitBtn
Left = 6 Left = 6
Height = 26 Height = 25
Top = 6 Top = 6
Width = 75 Width = 75
Align = alLeft Align = alLeft
@ -126,19 +128,19 @@ object ExtractProcDialog: TExtractProcDialog
object MissingIdentifiersGroupBox: TGroupBox object MissingIdentifiersGroupBox: TGroupBox
Left = 6 Left = 6
Height = 58 Height = 58
Top = 253 Top = 254
Width = 413 Width = 413
Align = alBottom Align = alBottom
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'MissingIdentifiersGroupBox' Caption = 'MissingIdentifiersGroupBox'
ClientHeight = 40 ClientHeight = 36
ClientWidth = 409 ClientWidth = 405
TabOrder = 3 TabOrder = 3
object MissingIdentifiersListBox: TListBox object MissingIdentifiersListBox: TListBox
Left = 0 Left = 0
Height = 40 Height = 36
Top = 0 Top = 0
Width = 409 Width = 405
Align = alClient Align = alClient
ItemHeight = 0 ItemHeight = 0
TabOrder = 0 TabOrder = 0
@ -146,24 +148,24 @@ object ExtractProcDialog: TExtractProcDialog
end end
object FunctionGroupBox: TGroupBox object FunctionGroupBox: TGroupBox
Left = 6 Left = 6
Height = 78 Height = 79
Top = 110 Top = 107
Width = 413 Width = 413
Align = alBottom Align = alBottom
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'FunctionGroupBox' Caption = 'FunctionGroupBox'
ClientHeight = 60 ClientHeight = 57
ClientWidth = 409 ClientWidth = 405
TabOrder = 4 TabOrder = 4
object FuncVariableLabel: TLabel object FuncVariableLabel: TLabel
AnchorSideLeft.Control = CreateFunctionCheckBox AnchorSideLeft.Control = CreateFunctionCheckBox
AnchorSideTop.Control = FuncVariableComboBox AnchorSideTop.Control = FuncVariableComboBox
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 16 Height = 17
Top = 34 Top = 32
Width = 97 Width = 115
Caption = 'FuncVariableLabel' Caption = 'FuncVariableLabel'
Enabled = False Enabled = False
ParentColor = False ParentColor = False
@ -172,9 +174,9 @@ object ExtractProcDialog: TExtractProcDialog
AnchorSideLeft.Control = FunctionGroupBox AnchorSideLeft.Control = FunctionGroupBox
AnchorSideTop.Control = FunctionGroupBox AnchorSideTop.Control = FunctionGroupBox
Left = 6 Left = 6
Height = 19 Height = 18
Top = 6 Top = 6
Width = 153 Width = 178
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'CreateFunctionCheckBox' Caption = 'CreateFunctionCheckBox'
OnChange = CreateFunctionCheckBoxChange OnChange = CreateFunctionCheckBoxChange
@ -187,14 +189,14 @@ object ExtractProcDialog: TExtractProcDialog
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = FunctionGroupBox AnchorSideRight.Control = FunctionGroupBox
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 109 Left = 127
Height = 23 Height = 21
Top = 31 Top = 30
Width = 294 Width = 272
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Enabled = False Enabled = False
ItemHeight = 15 ItemHeight = 0
TabOrder = 1 TabOrder = 1
Text = 'FuncVariableComboBox' Text = 'FuncVariableComboBox'
end end

14
ide/extractprocdlg.pas
View File

@ -66,6 +66,7 @@ type
private private
FMethodPossible: boolean; FMethodPossible: boolean;
FMissingIdentifiers: TAVLTree; FMissingIdentifiers: TAVLTree;
FSubProcPossible: boolean;
FSubProcSameLvlPossible: boolean; FSubProcSameLvlPossible: boolean;
FVariables: TAVLTree; FVariables: TAVLTree;
procedure SetMissingIdentifiers(const AValue: TAVLTree); procedure SetMissingIdentifiers(const AValue: TAVLTree);
@ -79,6 +80,7 @@ type
function GetFunctionNode: TCodeTreeNode; function GetFunctionNode: TCodeTreeNode;
property MethodPossible: boolean read FMethodPossible write FMethodPossible; property MethodPossible: boolean read FMethodPossible write FMethodPossible;
property SubProcPossible: boolean read FSubProcPossible write FSubProcPossible;
property SubProcSameLvlPossible: boolean read FSubProcSameLvlPossible write FSubProcSameLvlPossible; property SubProcSameLvlPossible: boolean read FSubProcSameLvlPossible write FSubProcSameLvlPossible;
property MissingIdentifiers: TAVLTree read FMissingIdentifiers write SetMissingIdentifiers; property MissingIdentifiers: TAVLTree read FMissingIdentifiers write SetMissingIdentifiers;
property Variables: TAVLTree read FVariables write SetVariables;// tree of TExtractedProcVariable property Variables: TAVLTree read FVariables write SetVariables;// tree of TExtractedProcVariable
@ -107,6 +109,7 @@ var
VarTree: TAVLTree; VarTree: TAVLTree;
FuncNode: TCodeTreeNode; FuncNode: TCodeTreeNode;
FunctionResultVariableStartPos: Integer; FunctionResultVariableStartPos: Integer;
SubProcPossible: boolean;
begin begin
Result:=mrCancel; Result:=mrCancel;
if CompareCaret(BlockBegin,BlockEnd)<=0 then begin if CompareCaret(BlockBegin,BlockEnd)<=0 then begin
@ -122,7 +125,7 @@ begin
VarTree:=CreateExtractProcVariableTree; VarTree:=CreateExtractProcVariableTree;
// check if selected statements can be extracted // check if selected statements can be extracted
if not CodeToolBoss.CheckExtractProc(Code,BlockBegin,BlockEnd,MethodPossible, if not CodeToolBoss.CheckExtractProc(Code,BlockBegin,BlockEnd,MethodPossible,
SubProcSameLvlPossible,MissingIdentifiers,VarTree) SubProcPossible,SubProcSameLvlPossible,MissingIdentifiers,VarTree)
then begin then begin
if CodeToolBoss.ErrorMessage='' then begin if CodeToolBoss.ErrorMessage='' then begin
MessageDlg(lisInvalidSelection, MessageDlg(lisInvalidSelection,
@ -136,6 +139,7 @@ begin
ExtractProcDialog:=TExtractProcDialog.Create(nil); ExtractProcDialog:=TExtractProcDialog.Create(nil);
try try
ExtractProcDialog.MethodPossible:=MethodPossible; ExtractProcDialog.MethodPossible:=MethodPossible;
ExtractProcDialog.SubProcPossible:=SubProcPossible;
ExtractProcDialog.SubProcSameLvlPossible:=SubProcSameLvlPossible; ExtractProcDialog.SubProcSameLvlPossible:=SubProcSameLvlPossible;
ExtractProcDialog.MissingIdentifiers:=MissingIdentifiers; ExtractProcDialog.MissingIdentifiers:=MissingIdentifiers;
ExtractProcDialog.UpdateAvailableTypes; ExtractProcDialog.UpdateAvailableTypes;
@ -280,9 +284,11 @@ begin
end; end;
Add(lisProcedure); Add(lisProcedure);
Add(lisProcedureWithInterface); Add(lisProcedureWithInterface);
Add(lisSubProcedure); if SubProcPossible then begin
if SubProcSameLvlPossible then Add(lisSubProcedure);
Add(lisSubProcedureOnSameLevel); if SubProcSameLvlPossible then
Add(lisSubProcedureOnSameLevel);
end;
EndUpdate; EndUpdate;
TypeRadiogroup.ItemIndex:=Count-1; TypeRadiogroup.ItemIndex:=Count-1;
end; end;