paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 13:09:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE+codetools: implemented Extract Function, issue #13108

Browse Source 
git-svn-id: trunk@19188 -
This commit is contained in:
mattias 2009-04-01 15:51:21 +00:00
parent e9ab826ce1
commit 77ab045b5b
6 changed files with 387 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/codetools/codetoolmanager.pas
View File

@ -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;

168
components/codetools/extractproctool.pas
View File

@ -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
// variables
if (ProcVar.UsedInSelection and ProcVar.UsedInNonSelection)
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,
BaseParamListCode: string): boolean;
function CreateProcParamList(
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+';';
CleanMethodDefinition:='procedure '+ProcName+BaseParamList+';';
MethodDefinition:=Keyword+' '+ProcName+CompleteParamList+';';
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
VarTree.FreeAndClear;
VarTree.Free;
end;
ClearExtractProcVariableTree(VarTree,true);
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

102
ide/extractprocdlg.lfm
View File

@ -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.25'
LCLVersion = '0.9.27'
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
Top = 194
Height = 54
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
Top = 317
Left = 0
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
Height = 26
Left = 341
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
Height = 26
Left = 260
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

66
ide/extractprocdlg.lrs
View File

@ -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
+'c'#1#3'Top'#3'v'#1#5'Width'#3#169#1#13'ActiveControl'#7#8'NameEdit'#11'Bord'
+'erIcons'#11#12'biSystemMenu'#0#7'Caption'#6#17'ExtractProcDialog'#12'Client'
+'Height'#3'c'#1#11'ClientWidth'#3#169#1#7'OnClose'#7#22'ExtractProcDialogClo'
+'se'#8'OnCreate'#7#23'ExtractProcDialogCREATE'#10'ParentFont'#8#10'LCLVersio'
+'n'#6#6'0.9.25'#0#11'TRadioGroup'#14'TypeRadiogroup'#24'AnchorSideBottom.Con'
+'trol'#7#12'NameGroupbox'#4'Left'#2#6#6'Height'#3#182#0#3'Top'#2#6#5'Width'#3
'TPF0'#18'TExtractProcDialog'#17'ExtractProcDialog'#4'Left'#3#137#1#6'Height'
+#3'c'#1#3'Top'#3#190#1#5'Width'#3#169#1#13'ActiveControl'#7#22'CreateFunctio'
+'nCheckBox'#11'BorderIcons'#11#12'biSystemMenu'#0#7'Caption'#6#17'ExtractPro'
+'cDialog'#12'ClientHeight'#3'c'#1#11'ClientWidth'#3#169#1#7'OnClose'#7#22'Ex'
+'tractProcDialogClose'#8'OnCreate'#7#23'ExtractProcDialogCREATE'#10'LCLVersi'
+'on'#6#6'0.9.27'#0#11'TRadioGroup'#14'TypeRadiogroup'#24'AnchorSideBottom.Co'
+'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'
+#8'NameEdit'#4'Left'#2#6#6'Height'#2#23#3'Top'#2#6#5'Width'#3#141#1#5'Align'
+#7#5'alTop'#20'BorderSpacing.Around'#2#6#8'TabOrder'#2#0#4'Text'#6#8'NameEdi'
+'t'#0#0#0#6'TPanel'#8'BtnPanel'#6'Height'#2'&'#3'Top'#3'='#1#5'Width'#3#169#1
+#5'Align'#7#8'alBottom'#8'AutoSize'#9#10'BevelOuter'#7#6'bvNone'#12'ClientHe'
+'ight'#2'&'#11'ClientWidth'#3#169#1#8'TabOrder'#2#2#0#7'TBitBtn'#12'CancelBu'
+'tton'#20'AnchorSideRight.Side'#7#9'asrBottom'#21'AnchorSideBottom.Side'#7#9
+'asrBottom'#4'Left'#3'X'#1#6'Height'#2#26#3'Top'#2#6#5'Width'#2'K'#5'Align'#7
+'t'#2'#'#11'ClientWidth'#3#153#1#8'TabOrder'#2#0#0#5'TEdit'#8'NameEdit'#4'Le'
+'ft'#2#6#6'Height'#2#23#3'Top'#2#6#5'Width'#3#141#1#5'Align'#7#5'alTop'#20'B'
+'orderSpacing.Around'#2#6#8'TabOrder'#2#0#4'Text'#6#8'NameEdit'#0#0#0#6'TPan'
+'el'#8'BtnPanel'#4'Left'#2#0#6'Height'#2'0'#3'Top'#3'3'#1#5'Width'#3#169#1#5
+'Align'#7#8'alBottom'#8'AutoSize'#9#10'BevelOuter'#7#6'bvNone'#12'ClientHeig'
+'ht'#2'0'#11'ClientWidth'#3#169#1#8'TabOrder'#2#2#0#7'TBitBtn'#12'CancelButt'
+'on'#20'AnchorSideRight.Side'#7#9'asrBottom'#21'AnchorSideBottom.Side'#7#9'a'
+'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
+#1#6'Height'#2#26#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#7'alRight'#8'AutoSize'
+#7'TBitBtn'#8'OkButton'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3#4
+#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
+'TabOrder'#2#3#0#8'TListBox'#25'MissingIdentifiersListBox'#6'Height'#2'('#5
+'Width'#3#153#1#5'Align'#7#8'alClient'#8'TabOrder'#2#0#0#0#0#0
+'issingIdentifiersGroupBox'#12'ClientHeight'#2''''#11'ClientWidth'#3#153#1#8
+'TabOrder'#2#3#0#8'TListBox'#25'MissingIdentifiersListBox'#4'Left'#2#0#6'Hei'
+'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
]);

146
ide/extractprocdlg.pas
View File

@ -22,8 +22,8 @@
Abstract:
Dialog for the Extract Proc feature.
Allows user choose what kind of procedure to create and shows missing
identifiers.
Allows user choose what kind of procedure/function to create and
shows missing identifiers.
}
unit ExtractProcDlg;
@ -32,9 +32,10 @@ unit ExtractProcDlg;
interface
uses
Classes, SysUtils, AVL_Tree, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Buttons, StdCtrls,
BasicCodeTools, CodeAtom, CodeCache, CodeToolManager, ExtractProcTool,
Classes, SysUtils, LCLProc, AVL_Tree, LResources, Forms, Controls, Graphics,
Dialogs, ExtCtrls, Buttons, StdCtrls,
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;
NameGroupbox: TGROUPBOX;
NameEdit: TEdit;
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}

2
ide/lazarusidestrconsts.pas
View File

@ -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