diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 5520e7c3f0..dbaf6128dd 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -542,7 +542,7 @@ type // extract proc (creates a new procedure from code in selection) function CheckExtractProc(Code: TCodeBuffer; const StartPoint, EndPoint: TPoint; - out MethodPossible, SubProcSameLvlPossible: boolean; + out MethodPossible, SubProcPossible, SubProcSameLvlPossible: boolean; out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition VarTree: TAVLTree = nil // tree of TExtractedProcVariable ): boolean; @@ -3880,10 +3880,9 @@ begin end; function TCodeToolManager.CheckExtractProc(Code: TCodeBuffer; const StartPoint, - EndPoint: TPoint; out MethodPossible, SubProcSameLvlPossible: boolean; - out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition - VarTree: TAVLTree // tree of TExtractedProcVariable - ): boolean; + EndPoint: TPoint; out MethodPossible, SubProcPossible, + SubProcSameLvlPossible: boolean; out MissingIdentifiers: TAVLTree; + VarTree: TAVLTree): boolean; var StartPos, EndPos: TCodeXYPosition; begin @@ -3900,8 +3899,8 @@ begin EndPos.Code:=Code; try Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible, - SubProcSameLvlPossible,MissingIdentifiers, - VarTree); + SubProcPossible,SubProcSameLvlPossible,MissingIdentifiers, + VarTree); except on e: Exception do Result:=HandleException(e); end; diff --git a/components/codetools/extractproctool.pas b/components/codetools/extractproctool.pas index b6b4d10ece..487b197dad 100644 --- a/components/codetools/extractproctool.pas +++ b/components/codetools/extractproctool.pas @@ -37,7 +37,7 @@ unit ExtractProcTool; {$mode objfpc}{$H+} -{off $define CTDEBUG} +{$define CTDEBUG} interface @@ -86,16 +86,16 @@ type protected function ScanNodesForVariables(const StartPos, EndPos: TCodeXYPosition; out BlockStartPos, BlockEndPos: integer; // the selection - out ProcNode: TCodeTreeNode; + out BlockNode: TCodeTreeNode; VarTree: TAVLTree; // tree of TExtractedProcVariable IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition MissingIdentifiers: TAVLTree // tree of PCodeXYPosition ): boolean; function InitExtractProc(const StartPos, EndPos: TCodeXYPosition; - out MethodPossible, SubProcSameLvlPossible: boolean): boolean; + out MethodPossible, SubProcPossible, SubProcSameLvlPossible: boolean): boolean; public function CheckExtractProc(const StartPos, EndPos: TCodeXYPosition; - out MethodPossible, SubProcSameLvlPossible: boolean; + out MethodPossible, SubProcPossible, SubProcSameLvlPossible: boolean; out MissingIdentifiers: TAVLTree; // tree of PCodeXYPosition VarTree: TAVLTree = nil // tree of TExtractedProcVariable ): boolean; @@ -176,8 +176,8 @@ end; { TExtractProcTool } function TExtractProcTool.InitExtractProc(const StartPos, - EndPos: TCodeXYPosition; - out MethodPossible, SubProcSameLvlPossible: boolean): boolean; + EndPos: TCodeXYPosition; out MethodPossible, SubProcPossible, + SubProcSameLvlPossible: boolean): boolean; var CleanStartPos, CleanEndPos: integer; CursorNode: TCodeTreeNode; @@ -189,6 +189,7 @@ var begin Result:=false; MethodPossible:=false; + SubProcPossible:=false; SubProcSameLvlPossible:=false; {$IFDEF CTDebug} DebugLn('TExtractProcTool.InitExtractProc syntax and cursor check ..'); @@ -275,6 +276,7 @@ begin ProcLvl:=0; while ANode<>nil do begin if (ANode.Desc=ctnProcedure) then begin + SubProcPossible:=true; inc(ProcLvl); if NodeIsInAMethod(ANode) then begin MethodPossible:=true; @@ -290,8 +292,9 @@ begin end; function TExtractProcTool.CheckExtractProc(const StartPos, - EndPos: TCodeXYPosition; out MethodPossible, SubProcSameLvlPossible: boolean; - out MissingIdentifiers: TAVLTree; VarTree: TAVLTree): boolean; + EndPos: TCodeXYPosition; out MethodPossible, SubProcPossible, + SubProcSameLvlPossible: boolean; out MissingIdentifiers: TAVLTree; + VarTree: TAVLTree): boolean; var BlockStartPos: integer; BlockEndPos: integer; @@ -301,7 +304,8 @@ begin MissingIdentifiers:=nil; ActivateGlobalWriteLock; try - if not InitExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible) + if not InitExtractProc(StartPos,EndPos,MethodPossible, + SubProcPossible,SubProcSameLvlPossible) then exit; MissingIdentifiers:=CreateTreeOfPCodeXYPosition; if not ScanNodesForVariables(StartPos,EndPos,BlockStartPos,BlockEndPos, @@ -322,7 +326,7 @@ const ShortProcFormat = [phpWithoutClassKeyword]; var 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; ResultNode: TCodeTreeNode; @@ -599,11 +603,21 @@ var {$IFDEF CTDebug} DebugLn('CreateProcNameParts A searching class name ..'); {$ENDIF} - ProcClassName:=ExtractClassNameOfProcNode(ProcNode); - if ProcClassName='' then exit; + if (MainBlockNode=nil) or (MainBlockNode.Desc<>ctnProcedure) then begin + 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, 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); end; {$IFDEF CTDebug} @@ -794,7 +808,11 @@ var eptSubProcedure: 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 BeginNode:=BeginNode.PriorBrother; InsertPos:=BeginNode.StartPos; @@ -805,14 +823,14 @@ var eptSubProcedureSameLvl: begin // -> insert in front of old proc - InsertPos:=FindLineEndOrCodeInFrontOfPosition(ProcNode.StartPos); - Indent:=GetLineIndent(Src,ProcNode.StartPos); + InsertPos:=FindLineEndOrCodeInFrontOfPosition(MainBlockNode.StartPos); + Indent:=GetLineIndent(Src,MainBlockNode.StartPos); end; eptProcedure,eptProcedureWithInterface: begin // insert in front of top level proc - InsertNode:=ProcNode; + InsertNode:=MainBlockNode; ANode:=InsertNode; while (ANode<>nil) do begin if ANode.Desc=ctnProcedure then @@ -843,8 +861,8 @@ var eptPublishedMethod,eptPrivateMethod,eptProtectedMethod,eptPublicMethod: begin // set default values - InsertPos:=FindLineEndOrCodeInFrontOfPosition(ProcNode.StartPos); - Indent:=GetLineIndent(Src,ProcNode.StartPos); + InsertPos:=FindLineEndOrCodeInFrontOfPosition(MainBlockNode.StartPos); + Indent:=GetLineIndent(Src,MainBlockNode.StartPos); end; else @@ -1070,17 +1088,22 @@ var NewProcPath: TStrings; ProcClassNode: TCodeTreeNode; ProcCode: string; + SubProcPossible: boolean; begin Result:=false; {$IFDEF CTDebug} DebugLn(['ExtractProc A ProcName="',ProcName,'" ProcType=',ExtractProcTypeNames[ProcType],' FunctionResultVariableStartPos=',FunctionResultVariableStartPos]); {$ENDIF} - if not InitExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible) + if not InitExtractProc(StartPos,EndPos,MethodPossible, + SubProcPossible,SubProcSameLvlPossible) then exit; if (not MethodPossible) and (ProcType in [eptPrivateMethod,eptProtectedMethod, eptPublicMethod,eptPublishedMethod]) then exit; + if (not SubProcPossible) + and (ProcType in [eptSubProcedure,eptSubProcedureSameLvl]) then + exit; if (not SubProcSameLvlPossible) and (ProcType=eptSubProcedureSameLvl) then exit; CodeCompleteSrcChgCache:=SourceChangeCache; @@ -1089,7 +1112,7 @@ begin NewProcPath:=nil; try 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 ReplaceSelectionWithCall then exit; if not DeleteMovedLocalVariables then exit; @@ -1123,7 +1146,7 @@ end; function TExtractProcTool.ScanNodesForVariables(const StartPos, EndPos: TCodeXYPosition; out BlockStartPos, BlockEndPos: integer; - out ProcNode: TCodeTreeNode; + out BlockNode: TCodeTreeNode; VarTree: TAVLTree; // tree of TExtractedProcVariable IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition MissingIdentifiers: TAVLTree// tree of PCodeXYPosition @@ -1279,11 +1302,11 @@ var if (Params.NewCodeTool=Self) and (Params.NewNode<>nil) then begin VarNode:=Params.NewNode; 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 // or one of its sub procs ClosestProcNode:=VarNode.GetNodeOfType(ctnProcedure); - if ClosestProcNode=ProcNode then begin + if ClosestProcNode=BlockNode then begin // VarNode is a variable defined by the main proc IsParameter:=VarNode.GetNodeOfType(ctnProcedureHead)<>nil; ParameterType:=ptNone; @@ -1350,12 +1373,11 @@ var Result:=false; ChildNode:=StartNode.FirstChild; while ChildNode<>nil do begin - if (ChildNode.Desc in [ctnBeginBlock,ctnAsmBlock]) - and (ChildNode.Parent.Desc=ctnProcedure) then begin + if (ChildNode.Desc in [ctnBeginBlock,ctnAsmBlock]) then begin if not ScanSourceForVariables(ChildNode.StartPos,ChildNode.EndPos) then exit; - end; - if not ScanNodesForVariablesRecursive(ChildNode) then exit; + end else if not ScanNodesForVariablesRecursive(ChildNode) then + exit; ChildNode:=ChildNode.NextBrother; end; Result:=true; @@ -1369,12 +1391,25 @@ begin if CaretToCleanPos(StartPos,BlockStartPos)<>0 then exit; if CaretToCleanPos(EndPos,BlockEndPos)<>0 then exit; 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 - ScanForLocalVariables(ProcNode); + ScanForLocalVariables(BlockNode); - if not ScanNodesForVariablesRecursive(ProcNode) then exit; + if not ScanNodesForVariablesRecursive(BlockNode) then exit; finally VarCandidates.Free; DeactivateGlobalWriteLock; diff --git a/ide/extractprocdlg.lfm b/ide/extractprocdlg.lfm index a036c5b72b..0cb5439528 100644 --- a/ide/extractprocdlg.lfm +++ b/ide/extractprocdlg.lfm @@ -1,7 +1,7 @@ object ExtractProcDialog: TExtractProcDialog - Left = 393 + Left = 374 Height = 355 - Top = 446 + Top = 360 Width = 425 ActiveControl = CreateFunctionCheckBox BorderIcons = [biSystemMenu] @@ -11,15 +11,17 @@ object ExtractProcDialog: TExtractProcDialog ClientWidth = 425 OnClose = ExtractProcDialogClose OnCreate = ExtractProcDialogCREATE - LCLVersion = '0.9.29' + Position = poScreenCenter + LCLVersion = '0.9.31' object TypeRadiogroup: TRadioGroup AnchorSideBottom.Control = NameGroupbox Left = 6 - Height = 98 + Height = 95 Top = 6 Width = 413 Align = alClient AutoFill = True + AutoSize = True BorderSpacing.Around = 6 Caption = 'TypeRadiogroup' ChildSizing.LeftRightSpacing = 6 @@ -39,21 +41,21 @@ object ExtractProcDialog: TExtractProcDialog AnchorSideRight.Control = Owner AnchorSideBottom.Control = CancelButton Left = 6 - Height = 53 - Top = 194 + Height = 56 + Top = 192 Width = 413 Align = alBottom AutoSize = True BorderSpacing.Around = 6 Caption = 'NameGroupbox' - ClientHeight = 35 - ClientWidth = 409 + ClientHeight = 34 + ClientWidth = 405 TabOrder = 0 object NameEdit: TEdit Left = 6 - Height = 23 + Height = 22 Top = 6 - Width = 397 + Width = 393 Align = alTop BorderSpacing.Around = 6 TabOrder = 0 @@ -62,20 +64,20 @@ object ExtractProcDialog: TExtractProcDialog end object BtnPanel: TPanel Left = 0 - Height = 38 - Top = 317 + Height = 37 + Top = 318 Width = 425 Align = alBottom AutoSize = True BevelOuter = bvNone - ClientHeight = 38 + ClientHeight = 37 ClientWidth = 425 TabOrder = 2 object CancelButton: TBitBtn - Left = 338 - Height = 26 + Left = 344 + Height = 25 Top = 6 - Width = 81 + Width = 75 Align = alRight AutoSize = True BorderSpacing.Around = 6 @@ -89,8 +91,8 @@ object ExtractProcDialog: TExtractProcDialog TabOrder = 0 end object OkButton: TBitBtn - Left = 257 - Height = 26 + Left = 263 + Height = 25 Top = 6 Width = 75 Align = alRight @@ -108,7 +110,7 @@ object ExtractProcDialog: TExtractProcDialog end object HelpButton: TBitBtn Left = 6 - Height = 26 + Height = 25 Top = 6 Width = 75 Align = alLeft @@ -126,19 +128,19 @@ object ExtractProcDialog: TExtractProcDialog object MissingIdentifiersGroupBox: TGroupBox Left = 6 Height = 58 - Top = 253 + Top = 254 Width = 413 Align = alBottom BorderSpacing.Around = 6 Caption = 'MissingIdentifiersGroupBox' - ClientHeight = 40 - ClientWidth = 409 + ClientHeight = 36 + ClientWidth = 405 TabOrder = 3 object MissingIdentifiersListBox: TListBox Left = 0 - Height = 40 + Height = 36 Top = 0 - Width = 409 + Width = 405 Align = alClient ItemHeight = 0 TabOrder = 0 @@ -146,24 +148,24 @@ object ExtractProcDialog: TExtractProcDialog end object FunctionGroupBox: TGroupBox Left = 6 - Height = 78 - Top = 110 + Height = 79 + Top = 107 Width = 413 Align = alBottom AutoSize = True BorderSpacing.Around = 6 Caption = 'FunctionGroupBox' - ClientHeight = 60 - ClientWidth = 409 + ClientHeight = 57 + ClientWidth = 405 TabOrder = 4 object FuncVariableLabel: TLabel AnchorSideLeft.Control = CreateFunctionCheckBox AnchorSideTop.Control = FuncVariableComboBox AnchorSideTop.Side = asrCenter Left = 6 - Height = 16 - Top = 34 - Width = 97 + Height = 17 + Top = 32 + Width = 115 Caption = 'FuncVariableLabel' Enabled = False ParentColor = False @@ -172,9 +174,9 @@ object ExtractProcDialog: TExtractProcDialog AnchorSideLeft.Control = FunctionGroupBox AnchorSideTop.Control = FunctionGroupBox Left = 6 - Height = 19 + Height = 18 Top = 6 - Width = 153 + Width = 178 BorderSpacing.Around = 6 Caption = 'CreateFunctionCheckBox' OnChange = CreateFunctionCheckBoxChange @@ -187,14 +189,14 @@ object ExtractProcDialog: TExtractProcDialog AnchorSideTop.Side = asrBottom AnchorSideRight.Control = FunctionGroupBox AnchorSideRight.Side = asrBottom - Left = 109 - Height = 23 - Top = 31 - Width = 294 + Left = 127 + Height = 21 + Top = 30 + Width = 272 Anchors = [akTop, akLeft, akRight] BorderSpacing.Around = 6 Enabled = False - ItemHeight = 15 + ItemHeight = 0 TabOrder = 1 Text = 'FuncVariableComboBox' end diff --git a/ide/extractprocdlg.pas b/ide/extractprocdlg.pas index 88c82c7949..535924811b 100644 --- a/ide/extractprocdlg.pas +++ b/ide/extractprocdlg.pas @@ -66,6 +66,7 @@ type private FMethodPossible: boolean; FMissingIdentifiers: TAVLTree; + FSubProcPossible: boolean; FSubProcSameLvlPossible: boolean; FVariables: TAVLTree; procedure SetMissingIdentifiers(const AValue: TAVLTree); @@ -79,6 +80,7 @@ type function GetFunctionNode: TCodeTreeNode; property MethodPossible: boolean read FMethodPossible write FMethodPossible; + property SubProcPossible: boolean read FSubProcPossible write FSubProcPossible; property SubProcSameLvlPossible: boolean read FSubProcSameLvlPossible write FSubProcSameLvlPossible; property MissingIdentifiers: TAVLTree read FMissingIdentifiers write SetMissingIdentifiers; property Variables: TAVLTree read FVariables write SetVariables;// tree of TExtractedProcVariable @@ -107,6 +109,7 @@ var VarTree: TAVLTree; FuncNode: TCodeTreeNode; FunctionResultVariableStartPos: Integer; + SubProcPossible: boolean; begin Result:=mrCancel; if CompareCaret(BlockBegin,BlockEnd)<=0 then begin @@ -122,7 +125,7 @@ begin VarTree:=CreateExtractProcVariableTree; // check if selected statements can be extracted if not CodeToolBoss.CheckExtractProc(Code,BlockBegin,BlockEnd,MethodPossible, - SubProcSameLvlPossible,MissingIdentifiers,VarTree) + SubProcPossible,SubProcSameLvlPossible,MissingIdentifiers,VarTree) then begin if CodeToolBoss.ErrorMessage='' then begin MessageDlg(lisInvalidSelection, @@ -136,6 +139,7 @@ begin ExtractProcDialog:=TExtractProcDialog.Create(nil); try ExtractProcDialog.MethodPossible:=MethodPossible; + ExtractProcDialog.SubProcPossible:=SubProcPossible; ExtractProcDialog.SubProcSameLvlPossible:=SubProcSameLvlPossible; ExtractProcDialog.MissingIdentifiers:=MissingIdentifiers; ExtractProcDialog.UpdateAvailableTypes; @@ -280,9 +284,11 @@ begin end; Add(lisProcedure); Add(lisProcedureWithInterface); - Add(lisSubProcedure); - if SubProcSameLvlPossible then - Add(lisSubProcedureOnSameLevel); + if SubProcPossible then begin + Add(lisSubProcedure); + if SubProcSameLvlPossible then + Add(lisSubProcedureOnSameLevel); + end; EndUpdate; TypeRadiogroup.ItemIndex:=Count-1; end;