mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-13 08:35:53 +02:00
coetools: extract proc: implemented collecting and ingnoring missing identifiers
git-svn-id: trunk@13559 -
This commit is contained in:
mattias
parent
f67db8d99a
commit
fd8a3de7c9
@ -39,7 +39,7 @@ uses
|
||||
{$IFDEF MEM_CHECK}
|
||||
MemCheck,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, FileProcs, CodeCache, KeywordFuncLists;
|
||||
Classes, SysUtils, FileProcs, AVL_Tree, CodeCache, KeywordFuncLists;
|
||||
|
||||
type
|
||||
TCodePosition = record
|
||||
@ -147,11 +147,18 @@ function CompareCodeXYPositions(Pos1, Pos2: PCodeXYPosition): integer;
|
||||
function CompareCodePositions(Pos1, Pos2: PCodePosition): integer;
|
||||
|
||||
procedure AddCodePosition(var ListOfPCodeXYPosition: TFPList;
|
||||
const NewCodePos: TCodeXYPosition);
|
||||
const NewCodePos: TCodeXYPosition);
|
||||
function IndexOfCodePosition(var ListOfPCodeXYPosition: TFPList;
|
||||
const APosition: PCodeXYPosition): integer;
|
||||
const APosition: PCodeXYPosition): integer;
|
||||
procedure FreeListOfPCodeXYPosition(ListOfPCodeXYPosition: TFPList);
|
||||
|
||||
function CreateTreeOfPCodeXYPosition: TAVLTree;
|
||||
procedure AddCodePosition(var TreeOfPCodeXYPosition: TAVLTree;
|
||||
const NewCodePos: TCodeXYPosition);
|
||||
procedure FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition: TAVLTree);
|
||||
procedure AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
|
||||
DestTree: TAVLTree; ClearList, CreateCopies: boolean);
|
||||
|
||||
var
|
||||
WordToAtomFlag: TWordToAtomFlag;
|
||||
|
||||
@ -244,6 +251,67 @@ begin
|
||||
ListOfPCodeXYPosition.Free;
|
||||
end;
|
||||
|
||||
function CreateTreeOfPCodeXYPosition: TAVLTree;
|
||||
begin
|
||||
Result:=TAVLTree.Create(TListSortCompare(@CompareCodeXYPositions));
|
||||
end;
|
||||
|
||||
procedure AddCodePosition(var TreeOfPCodeXYPosition: TAVLTree;
|
||||
const NewCodePos: TCodeXYPosition);
|
||||
var
|
||||
AddCodePos: PCodeXYPosition;
|
||||
begin
|
||||
if TreeOfPCodeXYPosition=nil then
|
||||
TreeOfPCodeXYPosition:=TAVLTree.Create(TListSortCompare(@CompareCodeXYPositions));
|
||||
New(AddCodePos);
|
||||
AddCodePos^:=NewCodePos;
|
||||
TreeOfPCodeXYPosition.Add(AddCodePos);
|
||||
end;
|
||||
|
||||
procedure FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition: TAVLTree);
|
||||
var
|
||||
ANode: TAVLTreeNode;
|
||||
CursorPos: PCodeXYPosition;
|
||||
begin
|
||||
if TreeOfPCodeXYPosition=nil then exit;
|
||||
ANode:=TreeOfPCodeXYPosition.FindLowest;
|
||||
while ANode<>nil do begin
|
||||
CursorPos:=PCodeXYPosition(ANode.Data);
|
||||
if CursorPos<>nil then
|
||||
Dispose(CursorPos);
|
||||
ANode:=TreeOfPCodeXYPosition.FindSuccessor(ANode);
|
||||
end;
|
||||
TreeOfPCodeXYPosition.Free;
|
||||
end;
|
||||
|
||||
procedure AddListToTreeOfPCodeXYPosition(SrcList: TFPList; DestTree: TAVLTree;
|
||||
ClearList, CreateCopies: boolean);
|
||||
var
|
||||
i: Integer;
|
||||
CodePos: PCodeXYPosition;
|
||||
NewCodePos: PCodeXYPosition;
|
||||
begin
|
||||
if SrcList=nil then exit;
|
||||
for i:=SrcList.Count-1 downto 0 do begin
|
||||
CodePos:=PCodeXYPosition(SrcList[i]);
|
||||
if DestTree.Find(CodePos)=nil then begin
|
||||
// new position -> add
|
||||
if CreateCopies and (not ClearList) then begin
|
||||
// list items should be kept and copies should be added to the tree
|
||||
New(NewCodePos);
|
||||
NewCodePos^:=CodePos^;
|
||||
end else
|
||||
NewCodePos:=CodePos;
|
||||
DestTree.Add(NewCodePos);
|
||||
end else if ClearList then begin
|
||||
// position alread exists and items should be deleted
|
||||
Dispose(NewCodePos);
|
||||
end;
|
||||
end;
|
||||
if ClearList then
|
||||
SrcList.Clear;
|
||||
end;
|
||||
|
||||
function DbgsCXY(const p: TCodeXYPosition): string;
|
||||
begin
|
||||
if p.Code=nil then
|
||||
|
||||
@ -480,9 +480,12 @@ type
|
||||
// extract proc (creates a new procedure from code in selection)
|
||||
function CheckExtractProc(Code: TCodeBuffer;
|
||||
const StartPoint, EndPoint: TPoint;
|
||||
var MethodPossible, SubProcSameLvlPossible: boolean): boolean;
|
||||
out MethodPossible, SubProcSameLvlPossible: boolean;
|
||||
out MissingIdentifiers: TAVLTree // tree of PCodeXYPosition
|
||||
): 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
|
||||
): boolean;
|
||||
|
||||
@ -1409,52 +1412,20 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCodeToolManager.FreeTreeOfPCodeXYPosition(var Tree: TAVLTree);
|
||||
var
|
||||
ANode: TAVLTreeNode;
|
||||
CursorPos: PCodeXYPosition;
|
||||
begin
|
||||
if Tree=nil then exit;
|
||||
ANode:=Tree.FindLowest;
|
||||
while ANode<>nil do begin
|
||||
CursorPos:=PCodeXYPosition(ANode.Data);
|
||||
if CursorPos<>nil then
|
||||
Dispose(CursorPos);
|
||||
ANode:=Tree.FindSuccessor(ANode);
|
||||
end;
|
||||
Tree.Free;
|
||||
CodeAtom.FreeTreeOfPCodeXYPosition(Tree);
|
||||
Tree:=nil;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.CreateTreeOfPCodeXYPosition: TAVLTree;
|
||||
begin
|
||||
Result:=TAVLTree.Create(TListSortCompare(@CompareCodeXYPositions));
|
||||
Result:=CodeAtom.CreateTreeOfPCodeXYPosition;
|
||||
end;
|
||||
|
||||
procedure TCodeToolManager.AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
|
||||
DestTree: TAVLTree; ClearList, CreateCopies: boolean);
|
||||
var
|
||||
i: Integer;
|
||||
CodePos: PCodeXYPosition;
|
||||
NewCodePos: PCodeXYPosition;
|
||||
begin
|
||||
if SrcList=nil then exit;
|
||||
for i:=SrcList.Count-1 downto 0 do begin
|
||||
CodePos:=PCodeXYPosition(SrcList[i]);
|
||||
if DestTree.Find(CodePos)=nil then begin
|
||||
// new position -> add
|
||||
if CreateCopies and (not ClearList) then begin
|
||||
// list items should be kept and copies should be added to the tree
|
||||
New(NewCodePos);
|
||||
NewCodePos^:=CodePos^;
|
||||
end else
|
||||
NewCodePos:=CodePos;
|
||||
DestTree.Add(NewCodePos);
|
||||
end else if ClearList then begin
|
||||
// position alread exists and items should be deleted
|
||||
Dispose(NewCodePos);
|
||||
end;
|
||||
end;
|
||||
if ClearList then
|
||||
SrcList.Clear;
|
||||
CodeAtom.AddListToTreeOfPCodeXYPosition(SrcList,DestTree,ClearList,CreateCopies);
|
||||
end;
|
||||
|
||||
function TCodeToolManager.Explore(Code: TCodeBuffer;
|
||||
@ -3350,7 +3321,9 @@ begin
|
||||
end;
|
||||
|
||||
function TCodeToolManager.CheckExtractProc(Code: TCodeBuffer; const StartPoint,
|
||||
EndPoint: TPoint; var MethodPossible, SubProcSameLvlPossible: boolean): boolean;
|
||||
EndPoint: TPoint; out MethodPossible, SubProcSameLvlPossible: boolean;
|
||||
out MissingIdentifiers: TAVLTree // tree of PCodeXYPosition
|
||||
): boolean;
|
||||
var
|
||||
StartPos, EndPos: TCodeXYPosition;
|
||||
begin
|
||||
@ -3367,7 +3340,7 @@ begin
|
||||
EndPos.Code:=Code;
|
||||
try
|
||||
Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible,
|
||||
SubProcSameLvlPossible);
|
||||
SubProcSameLvlPossible,MissingIdentifiers);
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
@ -3375,6 +3348,7 @@ 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
|
||||
StartPos, EndPos: TCodeXYPosition;
|
||||
@ -3393,7 +3367,7 @@ begin
|
||||
EndPos.Code:=Code;
|
||||
try
|
||||
Result:=FCurCodeTool.ExtractProc(StartPos,EndPos,ProcType,ProcName,
|
||||
NewPos,NewTopLine,SourceChangeCache);
|
||||
IgnoreIdentifiers,NewPos,NewTopLine,SourceChangeCache);
|
||||
if Result then begin
|
||||
NewX:=NewPos.X;
|
||||
NewY:=NewPos.Y;
|
||||
|
||||
@ -43,6 +43,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileProcs, CodeToolsStrConsts, CodeTree, CodeAtom,
|
||||
CustomCodeTool,
|
||||
PascalParserTool, CodeCompletionTool, KeywordFuncLists, BasicCodeTools,
|
||||
LinkScanner, AVL_Tree, SourceChanger,
|
||||
FindDeclarationTool;
|
||||
@ -62,11 +63,24 @@ type
|
||||
);
|
||||
|
||||
TExtractProcTool = class(TCodeCompletionCodeTool)
|
||||
protected
|
||||
function ScanNodesForVariables(const StartPos, EndPos: TCodeXYPosition;
|
||||
out BlockStartPos, BlockEndPos: integer; // the selection
|
||||
out ProcNode: 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;
|
||||
public
|
||||
function CheckExtractProc(const StartPos, EndPos: TCodeXYPosition;
|
||||
var MethodPossible, SubProcSameLvlPossible: boolean): boolean;
|
||||
out MethodPossible, SubProcSameLvlPossible: boolean;
|
||||
out MissingIdentifiers: TAVLTree // tree of PCodeXYPosition
|
||||
): 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;
|
||||
end;
|
||||
@ -141,9 +155,9 @@ end;
|
||||
|
||||
{ TExtractProcTool }
|
||||
|
||||
function TExtractProcTool.CheckExtractProc(const StartPos,
|
||||
function TExtractProcTool.InitExtractProc(const StartPos,
|
||||
EndPos: TCodeXYPosition;
|
||||
var MethodPossible, SubProcSameLvlPossible: boolean): boolean;
|
||||
out MethodPossible, SubProcSameLvlPossible: boolean): boolean;
|
||||
var
|
||||
CleanStartPos, CleanEndPos: integer;
|
||||
CursorNode: TCodeTreeNode;
|
||||
@ -157,15 +171,15 @@ begin
|
||||
MethodPossible:=false;
|
||||
SubProcSameLvlPossible:=false;
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('TExtractProcTool.CheckExtractProc syntax and cursor check ..');
|
||||
DebugLn('TExtractProcTool.InitExtractProc syntax and cursor check ..');
|
||||
{$ENDIF}
|
||||
// check syntax
|
||||
BuildTreeAndGetCleanPos(trAll,StartPos,CleanStartPos,[]);
|
||||
if CaretToCleanPos(EndPos,CleanEndPos)<>0 then exit;
|
||||
if CleanStartPos>=CleanEndPos then exit;
|
||||
{$IFDEF CTDebug}
|
||||
debugln('TExtractProcTool.CheckExtractProc Selection="',copy(Src,CleanStartPos,CleanEndPos-CleanStartPos),'"');
|
||||
DebugLn('TExtractProcTool.CheckExtractProc node check ..');
|
||||
debugln('TExtractProcTool.InitExtractProc Selection="',copy(Src,CleanStartPos,CleanEndPos-CleanStartPos),'"');
|
||||
DebugLn('TExtractProcTool.InitExtractProc node check ..');
|
||||
{$ENDIF}
|
||||
// check if in a Begin..End block
|
||||
CursorNode:=FindDeepestNodeAtPos(CleanStartPos,true);
|
||||
@ -173,7 +187,7 @@ begin
|
||||
BeginBlockNode:=CursorNode.GetNodeOfType(ctnBeginBlock);
|
||||
if BeginBlockNode=nil then exit;
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('TExtractProcTool.CheckExtractProc Start/End check ..');
|
||||
DebugLn('TExtractProcTool.InitExtractProc Start/End check ..');
|
||||
{$ENDIF}
|
||||
// check if Start and End on same block level
|
||||
MoveCursorToNodeStart(CursorNode);
|
||||
@ -183,16 +197,16 @@ begin
|
||||
if (CurPos.EndPos>CleanEndPos) or (CurPos.StartPos>SrcLen)
|
||||
or (CurPos.StartPos>CursorNode.EndPos) then
|
||||
break;
|
||||
//debugln('TExtractProcTool.CheckExtractProc A "',GetAtom,'"');
|
||||
//debugln('TExtractProcTool.InitExtractProc A "',GetAtom,'"');
|
||||
if WordIsBlockStatementStart.DoItUpperCase(UpperSrc,
|
||||
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
|
||||
then begin
|
||||
//debugln('TExtractProcTool.CheckExtractProc WordIsBlockStatementStart "',GetAtom,'"');
|
||||
//debugln('TExtractProcTool.InitExtractProc WordIsBlockStatementStart "',GetAtom,'"');
|
||||
BlockCleanStart:=CurPos.StartPos;
|
||||
if not ReadTilBlockStatementEnd(true) then exit;
|
||||
BlockCleanEnd:=CurPos.EndPos;
|
||||
debugln(copy(Src,BlockCleanStart,BlockCleanEnd-BlockCleanStart));
|
||||
//debugln('TExtractProcTool.CheckExtractProc BlockEnd "',GetAtom,'" BlockCleanEnd=',dbgs(BlockCleanEnd),' CleanEndPos=',dbgs(CleanEndPos),' Result=',dbgs(Result),' BlockStartedInside=',dbgs(BlockCleanStart>=CleanStartPos));
|
||||
//debugln('TExtractProcTool.InitExtractProc BlockEnd "',GetAtom,'" BlockCleanEnd=',dbgs(BlockCleanEnd),' CleanEndPos=',dbgs(CleanEndPos),' Result=',dbgs(Result),' BlockStartedInside=',dbgs(BlockCleanStart>=CleanStartPos));
|
||||
if BlockCleanStart<CleanStartPos then begin
|
||||
// this block started outside the selection
|
||||
// -> it should end outside
|
||||
@ -214,7 +228,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
//debugln('TExtractProcTool.CheckExtractProc Block ok');
|
||||
//debugln('TExtractProcTool.InitExtractProc Block ok');
|
||||
end
|
||||
else if WordIsBlockStatementEnd.DoItUpperCase(UpperSrc,
|
||||
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
|
||||
@ -234,7 +248,7 @@ begin
|
||||
// check if end not in a statement
|
||||
// ToDo
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('TExtractProcTool.CheckExtractProc Method check ..');
|
||||
DebugLn('TExtractProcTool.InitExtractProc Method check ..');
|
||||
{$ENDIF}
|
||||
// check if in a method body
|
||||
ANode:=CursorNode;
|
||||
@ -250,216 +264,46 @@ begin
|
||||
end;
|
||||
SubProcSameLvlPossible:=(ProcLvl>1);
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('TExtractProcTool.CheckExtractProc END');
|
||||
DebugLn('TExtractProcTool.InitExtractProc END');
|
||||
{$ENDIF}
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TExtractProcTool.CheckExtractProc(const StartPos,
|
||||
EndPos: TCodeXYPosition; out MethodPossible, SubProcSameLvlPossible: boolean;
|
||||
out MissingIdentifiers: TAVLTree): boolean;
|
||||
var
|
||||
BlockStartPos: integer;
|
||||
BlockEndPos: integer;
|
||||
ProcNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
if not InitExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible)
|
||||
then exit;
|
||||
MissingIdentifiers:=CreateTreeOfPCodeXYPosition;
|
||||
if not ScanNodesForVariables(StartPos,EndPos,BlockStartPos,BlockEndPos,
|
||||
ProcNode,nil,nil,MissingIdentifiers) then exit;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
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;
|
||||
type
|
||||
TParameterType = (ptNone, ptConst, ptVar, ptOut, ptNoSpecifier);
|
||||
const
|
||||
ShortProcFormat = [phpWithoutClassKeyword];
|
||||
{$IFDEF CTDebug}
|
||||
ParameterTypeNames: array[TParameterType] of string = (
|
||||
'ptNone', 'ptConst', 'ptVar', 'ptOut', 'ptNoSpecifier');
|
||||
{$ENDIF}
|
||||
type
|
||||
TParameterType = (ptNone, ptConst, ptVar, ptOut, ptNoSpecifier);
|
||||
var
|
||||
BlockStartPos, BlockEndPos: integer; // the selection
|
||||
ProcNode: TCodeTreeNode; // the main proc node of the selection
|
||||
VarTree: TAVLTree;
|
||||
|
||||
procedure AddVariableToTree(VarNode: TCodeTreeNode; IsInSelection,
|
||||
IsAfterSelection, IsChanged: boolean; ParameterType: TParameterType);
|
||||
var
|
||||
AVLNode: TAVLTreeNode;
|
||||
ProcVar: TExtractedProcVariable;
|
||||
begin
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('AddVariableToTree A Ident=',GetIdentifier(@Src[VarNode.StartPos]),
|
||||
' IsInSelection=',dbgs(IsInSelection),
|
||||
' ParameterType=',ParameterTypeNames[ParameterType]);
|
||||
{$ENDIF}
|
||||
if VarTree=nil then
|
||||
VarTree:=TAVLTree.Create(TListSortCompare(@CompareExtractedProcVariables));
|
||||
AVLNode:=VarTree.FindKey(VarNode,TListSortCompare(@CompareNodeWithExtractedProcVariable));
|
||||
if AVLNode<>nil then begin
|
||||
ProcVar:=TExtractedProcVariable(AVLNode.Data);
|
||||
end else begin
|
||||
ProcVar:=TExtractedProcVariable.Create;
|
||||
ProcVar.Node:=VarNode;
|
||||
end;
|
||||
ProcVar.ReadInSelection:=ProcVar.ReadInSelection or IsInSelection;
|
||||
ProcVar.WriteInSelection:=ProcVar.WriteInSelection
|
||||
or (IsInSelection and IsChanged);
|
||||
ProcVar.UsedInNonSelection:=ProcVar.UsedInNonSelection
|
||||
or (not IsInSelection) or (ParameterType<>ptNone);
|
||||
if (not ProcVar.ReadAfterSelectionValid) then begin
|
||||
// a) variable is a var or out parameter
|
||||
// => the variable value IS needed after the extracted proc
|
||||
// b) just after the selection the variable is read
|
||||
// => the variable value IS needed after the extracted proc
|
||||
// c) just after the selection the variable is written
|
||||
// => the variable value IS NOT needed after the extracted proc
|
||||
if (ParameterType in [ptOut,ptVar]) then begin
|
||||
ProcVar.ReadAfterSelectionValid:=true;
|
||||
ProcVar.ReadAfterSelection:=true;
|
||||
end else if (not IsInSelection) and IsAfterSelection then begin
|
||||
ProcVar.ReadAfterSelectionValid:=true;
|
||||
ProcVar.ReadAfterSelection:=not IsChanged;
|
||||
end;
|
||||
end;
|
||||
if AVLNode=nil then begin
|
||||
if ParameterType<>ptNone then
|
||||
ProcVar.VarType:=epvtParameter
|
||||
else
|
||||
ProcVar.VarType:=epvtLocalVar;
|
||||
VarTree.Add(ProcVar);
|
||||
end;
|
||||
end;
|
||||
|
||||
function VariableIsChanged(VarStartPos: integer): boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
MoveCursorToCleanPos(VarStartPos);
|
||||
// read identifier
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag in [cafRoundBracketOpen] then
|
||||
ReadTilBracketClose(true);
|
||||
// read next atom
|
||||
ReadNextAtom;
|
||||
if AtomIs(':=') or AtomIs('+=') or AtomIs('-=') or AtomIs('*=')
|
||||
or AtomIs('/=') then begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CheckVariableAtCursor: boolean;
|
||||
// find declaration of identifier at cursor and add to variable tree
|
||||
var
|
||||
Params: TFindDeclarationParams;
|
||||
VarStartPos: Integer;
|
||||
VarNode: TCodeTreeNode;
|
||||
IsInSelection: Boolean;
|
||||
ClosestProcNode: TCodeTreeNode;
|
||||
IsParameter: boolean;
|
||||
IsChanged: Boolean;
|
||||
IsAfterSelection: Boolean;
|
||||
ParameterType: TParameterType;
|
||||
begin
|
||||
Result:=false;
|
||||
// find start of variable
|
||||
VarStartPos:=FindStartOfVariable(CurPos.StartPos);
|
||||
IsInSelection:=(VarStartPos>=BlockStartPos) and (VarStartPos<BlockEndPos);
|
||||
IsAfterSelection:=(VarStartPos>=BlockEndPos);
|
||||
MoveCursorToCleanPos(VarStartPos);
|
||||
Params:=TFindDeclarationParams.Create;
|
||||
try
|
||||
// find declaration
|
||||
Params.ContextNode:=FindDeepestNodeAtPos(VarStartPos,true);
|
||||
Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
|
||||
fdfTopLvlResolving,fdfSearchInAncestors];
|
||||
// ToDo: Params.OnTopLvlIdentifierFound:=@OnTopLvlIdentifierFound;
|
||||
Params.SetIdentifier(Self,@Src[VarStartPos],@CheckSrcIdentifier);
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('AddVariableAtCursor Searching ',GetIdentifier(Params.Identifier));
|
||||
{$ENDIF}
|
||||
if not FindDeclarationOfIdentAtParam(Params) then begin
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('AddVariableAtCursor B not found');
|
||||
{$ENDIF}
|
||||
exit;
|
||||
end;
|
||||
// check if declaration is local variable
|
||||
if (Params.NewCodeTool=Self) and (Params.NewNode<>nil) then begin
|
||||
VarNode:=Params.NewNode;
|
||||
if (VarNode.Desc=ctnVarDefinition)
|
||||
and (VarNode.HasAsParent(ProcNode)) 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
|
||||
// VarNode is a variable defined by the main proc
|
||||
IsParameter:=VarNode.GetNodeOfType(ctnProcedureHead)<>nil;
|
||||
ParameterType:=ptNone;
|
||||
if IsParameter then begin
|
||||
MoveCursorToParameterSpecifier(VarNode);
|
||||
if UpAtomIs('CONST') then
|
||||
ParameterType:=ptConst
|
||||
else if UpAtomIs('VAR') then
|
||||
ParameterType:=ptVar
|
||||
else if UpAtomIs('OUT') then
|
||||
ParameterType:=ptOut
|
||||
else
|
||||
ParameterType:=ptNoSpecifier;
|
||||
end;
|
||||
IsChanged:=VariableIsChanged(VarStartPos);
|
||||
AddVariableToTree(VarNode,IsInSelection,IsAfterSelection,IsChanged,
|
||||
ParameterType);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Params.Free;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function ScanSourceForVariables(CleanStartPos, CleanEndPos: integer): boolean;
|
||||
// scan part of the source for variables
|
||||
var
|
||||
LastAtomType: TCommonAtomFlag;
|
||||
OldCursor: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('TExtractProcTool.ScanSourceForVariables A "',copy(Src,CleanStartPos,CleanEndPos-CleanStartPos),'"');
|
||||
{$ENDIF}
|
||||
MoveCursorToNearestAtom(CleanStartPos);
|
||||
while CurPos.StartPos<CleanEndPos do begin
|
||||
LastAtomType:=CurPos.Flag;
|
||||
ReadNextAtom;
|
||||
if AtomIsIdentifier(false) and (LastAtomType<>cafPoint) then begin
|
||||
// this could be the start of a variable -> check
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('ScanSourceForVariables B Identifier=',GetAtom);
|
||||
{$ENDIF}
|
||||
OldCursor:=CurPos.StartPos;
|
||||
if not CheckVariableAtCursor then exit;
|
||||
// restore cursor
|
||||
MoveCursorToCleanPos(OldCursor);
|
||||
ReadNextAtom;
|
||||
end;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function ScanNodesForVariables(StartNode: TCodeTreeNode): boolean;
|
||||
// scan recursively all statements for variables
|
||||
var
|
||||
ChildNode: TCodeTreeNode;
|
||||
begin
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('TExtractProcTool.ScanNodesForVariables A Node=',StartNode.DescAsString);
|
||||
{$ENDIF}
|
||||
Result:=false;
|
||||
ChildNode:=StartNode.FirstChild;
|
||||
while ChildNode<>nil do begin
|
||||
if (ChildNode.Desc in [ctnBeginBlock,ctnAsmBlock])
|
||||
and (ChildNode.Parent.Desc=ctnProcedure) then begin
|
||||
if not ScanSourceForVariables(ChildNode.StartPos,ChildNode.EndPos) then
|
||||
exit;
|
||||
end;
|
||||
if not ScanNodesForVariables(ChildNode) then exit;
|
||||
ChildNode:=ChildNode.NextBrother;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function ReplaceSelectionWithCall: boolean;
|
||||
var
|
||||
Indent: Integer;
|
||||
@ -1154,12 +998,10 @@ var
|
||||
ProcCode: string;
|
||||
begin
|
||||
Result:=false;
|
||||
MethodPossible:=false;
|
||||
SubProcSameLvlPossible:=false;
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('ExtractProc A ProcName="',ProcName,'" ProcType=',ExtractProcTypeNames[ProcType]);
|
||||
{$ENDIF}
|
||||
if not CheckExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible)
|
||||
if not InitExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible)
|
||||
then exit;
|
||||
if (not MethodPossible) and (ProcType in [eptPrivateMethod,eptProtectedMethod,
|
||||
eptPublicMethod,eptPublishedMethod])
|
||||
@ -1167,16 +1009,13 @@ begin
|
||||
exit;
|
||||
if (not SubProcSameLvlPossible) and (ProcType=eptSubProcedureSameLvl) then
|
||||
exit;
|
||||
if CaretToCleanPos(StartPos,BlockStartPos)<>0 then exit;
|
||||
if CaretToCleanPos(EndPos,BlockEndPos)<>0 then exit;
|
||||
BuildSubTree(BlockStartPos);
|
||||
CodeCompleteSrcChgCache:=SourceChangeCache;
|
||||
ProcNode:=FindDeepestNodeAtPos(BlockStartPos,true).GetNodeOfType(ctnProcedure);
|
||||
|
||||
VarTree:=nil;
|
||||
VarTree:=TAVLTree.Create(TListSortCompare(@CompareExtractedProcVariables));
|
||||
NewProcPath:=nil;
|
||||
try
|
||||
if not ScanNodesForVariables(ProcNode) then exit;
|
||||
if not ScanNodesForVariables(StartPos,EndPos,BlockStartPos,BlockEndPos,
|
||||
ProcNode,VarTree,IgnoreIdentifiers,nil) then exit;
|
||||
if not ReplaceSelectionWithCall then exit;
|
||||
if not DeleteMovedLocalVariables then exit;
|
||||
if not CreateProcNameParts(ProcClassName,ProcClassNode) then exit;
|
||||
@ -1205,5 +1044,234 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TExtractProcTool.ScanNodesForVariables(const StartPos,
|
||||
EndPos: TCodeXYPosition; out BlockStartPos, BlockEndPos: integer;
|
||||
out ProcNode: TCodeTreeNode;
|
||||
VarTree: TAVLTree; // tree of TExtractedProcVariable
|
||||
IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
|
||||
MissingIdentifiers: TAVLTree// tree of PCodeXYPosition
|
||||
): boolean;
|
||||
type
|
||||
TParameterType = (ptNone, ptConst, ptVar, ptOut, ptNoSpecifier);
|
||||
|
||||
procedure AddVariableToTree(VarNode: TCodeTreeNode; IsInSelection,
|
||||
IsAfterSelection, IsChanged: boolean; ParameterType: TParameterType);
|
||||
var
|
||||
AVLNode: TAVLTreeNode;
|
||||
ProcVar: TExtractedProcVariable;
|
||||
begin
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('AddVariableToTree A Ident=',GetIdentifier(@Src[VarNode.StartPos]),
|
||||
' IsInSelection=',dbgs(IsInSelection),
|
||||
' ParameterType=',ParameterTypeNames[ParameterType]);
|
||||
{$ENDIF}
|
||||
if VarTree=nil then exit;
|
||||
|
||||
AVLNode:=VarTree.FindKey(VarNode,TListSortCompare(@CompareNodeWithExtractedProcVariable));
|
||||
if AVLNode<>nil then begin
|
||||
ProcVar:=TExtractedProcVariable(AVLNode.Data);
|
||||
end else begin
|
||||
ProcVar:=TExtractedProcVariable.Create;
|
||||
ProcVar.Node:=VarNode;
|
||||
end;
|
||||
ProcVar.ReadInSelection:=ProcVar.ReadInSelection or IsInSelection;
|
||||
ProcVar.WriteInSelection:=ProcVar.WriteInSelection
|
||||
or (IsInSelection and IsChanged);
|
||||
ProcVar.UsedInNonSelection:=ProcVar.UsedInNonSelection
|
||||
or (not IsInSelection) or (ParameterType<>ptNone);
|
||||
if (not ProcVar.ReadAfterSelectionValid) then begin
|
||||
// a) variable is a var or out parameter
|
||||
// => the variable value IS needed after the extracted proc
|
||||
// b) just after the selection the variable is read
|
||||
// => the variable value IS needed after the extracted proc
|
||||
// c) just after the selection the variable is written
|
||||
// => the variable value IS NOT needed after the extracted proc
|
||||
if (ParameterType in [ptOut,ptVar]) then begin
|
||||
ProcVar.ReadAfterSelectionValid:=true;
|
||||
ProcVar.ReadAfterSelection:=true;
|
||||
end else if (not IsInSelection) and IsAfterSelection then begin
|
||||
ProcVar.ReadAfterSelectionValid:=true;
|
||||
ProcVar.ReadAfterSelection:=not IsChanged;
|
||||
end;
|
||||
end;
|
||||
if AVLNode=nil then begin
|
||||
if ParameterType<>ptNone then
|
||||
ProcVar.VarType:=epvtParameter
|
||||
else
|
||||
ProcVar.VarType:=epvtLocalVar;
|
||||
VarTree.Add(ProcVar);
|
||||
end;
|
||||
end;
|
||||
|
||||
function VariableIsChanged(VarStartPos: integer): boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
MoveCursorToCleanPos(VarStartPos);
|
||||
// read identifier
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag in [cafRoundBracketOpen] then
|
||||
ReadTilBracketClose(true);
|
||||
// read next atom
|
||||
ReadNextAtom;
|
||||
if AtomIs(':=') or AtomIs('+=') or AtomIs('-=') or AtomIs('*=')
|
||||
or AtomIs('/=') then begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CheckVariableAtCursor: boolean;
|
||||
// find declaration of identifier at cursor and add to variable tree
|
||||
var
|
||||
Params: TFindDeclarationParams;
|
||||
VarStartPos: Integer;
|
||||
VarNode: TCodeTreeNode;
|
||||
IsInSelection: Boolean;
|
||||
ClosestProcNode: TCodeTreeNode;
|
||||
IsParameter: boolean;
|
||||
IsChanged: Boolean;
|
||||
IsAfterSelection: Boolean;
|
||||
ParameterType: TParameterType;
|
||||
NewCodePos: TCodeXYPosition;
|
||||
begin
|
||||
Result:=false;
|
||||
// find start of variable
|
||||
VarStartPos:=FindStartOfVariable(CurPos.StartPos);
|
||||
if (IgnoreIdentifiers<>nil) then begin
|
||||
if not CleanPosToCaret(VarStartPos,NewCodePos) then exit;
|
||||
if IgnoreIdentifiers.Find(@NewCodePos)<>nil then exit(true);
|
||||
end;
|
||||
|
||||
IsInSelection:=(VarStartPos>=BlockStartPos) and (VarStartPos<BlockEndPos);
|
||||
IsAfterSelection:=(VarStartPos>=BlockEndPos);
|
||||
MoveCursorToCleanPos(VarStartPos);
|
||||
Params:=TFindDeclarationParams.Create;
|
||||
try
|
||||
// find declaration
|
||||
Params.ContextNode:=FindDeepestNodeAtPos(VarStartPos,true);
|
||||
Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound,
|
||||
fdfTopLvlResolving,fdfSearchInAncestors];
|
||||
Params.SetIdentifier(Self,@Src[VarStartPos],@CheckSrcIdentifier);
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('AddVariableAtCursor Searching ',GetIdentifier(Params.Identifier));
|
||||
{$ENDIF}
|
||||
try
|
||||
FindDeclarationOfIdentAtParam(Params);
|
||||
except
|
||||
on E: ECodeToolError do begin
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('AddVariableAtCursor identifier not found ',GetIdentifier(@Src[VarStartPos]));
|
||||
{$ENDIF}
|
||||
if MissingIdentifiers=nil then
|
||||
raise;
|
||||
// collect missing identifiers
|
||||
if not CleanPosToCaret(VarStartPos,NewCodePos) then exit;
|
||||
AddCodePosition(MissingIdentifiers,NewCodePos);
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
// check if declaration is local variable
|
||||
if (Params.NewCodeTool=Self) and (Params.NewNode<>nil) then begin
|
||||
VarNode:=Params.NewNode;
|
||||
if (VarNode.Desc=ctnVarDefinition)
|
||||
and (VarNode.HasAsParent(ProcNode)) 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
|
||||
// VarNode is a variable defined by the main proc
|
||||
IsParameter:=VarNode.GetNodeOfType(ctnProcedureHead)<>nil;
|
||||
ParameterType:=ptNone;
|
||||
if IsParameter then begin
|
||||
MoveCursorToParameterSpecifier(VarNode);
|
||||
if UpAtomIs('CONST') then
|
||||
ParameterType:=ptConst
|
||||
else if UpAtomIs('VAR') then
|
||||
ParameterType:=ptVar
|
||||
else if UpAtomIs('OUT') then
|
||||
ParameterType:=ptOut
|
||||
else
|
||||
ParameterType:=ptNoSpecifier;
|
||||
end;
|
||||
IsChanged:=VariableIsChanged(VarStartPos);
|
||||
AddVariableToTree(VarNode,IsInSelection,IsAfterSelection,IsChanged,
|
||||
ParameterType);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Params.Free;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function ScanSourceForVariables(CleanStartPos, CleanEndPos: integer): boolean;
|
||||
// scan part of the source for variables
|
||||
var
|
||||
LastAtomType: TCommonAtomFlag;
|
||||
OldCursor: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('TExtractProcTool.ScanSourceForVariables A "',copy(Src,CleanStartPos,CleanEndPos-CleanStartPos),'"');
|
||||
{$ENDIF}
|
||||
MoveCursorToNearestAtom(CleanStartPos);
|
||||
while CurPos.StartPos<CleanEndPos do begin
|
||||
LastAtomType:=CurPos.Flag;
|
||||
ReadNextAtom;
|
||||
if AtomIsIdentifier(false) and (LastAtomType<>cafPoint) then begin
|
||||
// this could be the start of a variable -> check
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('ScanSourceForVariables B Identifier=',GetAtom);
|
||||
{$ENDIF}
|
||||
OldCursor:=CurPos.StartPos;
|
||||
if not CheckVariableAtCursor then exit;
|
||||
// restore cursor
|
||||
MoveCursorToCleanPos(OldCursor);
|
||||
ReadNextAtom;
|
||||
end;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function ScanNodesForVariablesRecursive(StartNode: TCodeTreeNode): boolean;
|
||||
// scan recursively all statements for variables
|
||||
var
|
||||
ChildNode: TCodeTreeNode;
|
||||
begin
|
||||
{$IFDEF CTDebug}
|
||||
DebugLn('ScanNodesForVariablesRecursive A Node=',StartNode.DescAsString);
|
||||
{$ENDIF}
|
||||
Result:=false;
|
||||
ChildNode:=StartNode.FirstChild;
|
||||
while ChildNode<>nil do begin
|
||||
if (ChildNode.Desc in [ctnBeginBlock,ctnAsmBlock])
|
||||
and (ChildNode.Parent.Desc=ctnProcedure) then begin
|
||||
if not ScanSourceForVariables(ChildNode.StartPos,ChildNode.EndPos) then
|
||||
exit;
|
||||
end;
|
||||
if not ScanNodesForVariablesRecursive(ChildNode) then exit;
|
||||
ChildNode:=ChildNode.NextBrother;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result:=false;
|
||||
if CaretToCleanPos(StartPos,BlockStartPos)<>0 then exit;
|
||||
if CaretToCleanPos(EndPos,BlockEndPos)<>0 then exit;
|
||||
BuildSubTree(BlockStartPos);
|
||||
ProcNode:=FindDeepestNodeAtPos(BlockStartPos,true).GetNodeOfType(ctnProcedure);
|
||||
|
||||
ActivateGlobalWriteLock;
|
||||
try
|
||||
if not ScanNodesForVariablesRecursive(ProcNode) then exit;
|
||||
finally
|
||||
DeactivateGlobalWriteLock;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -933,7 +933,7 @@ begin
|
||||
Add('LO' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('HI' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('ORD' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('PREC' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('PRED' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('SUCC' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('LENGTH' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('SETLENGTH' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
@ -954,6 +954,8 @@ begin
|
||||
Add('EXIT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('BREAK' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('CONTINUE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('NEW' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('DISPOSE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
end;
|
||||
|
||||
WordIsTermOperator:=TKeyWordFunctionList.Create;
|
||||
@ -1323,6 +1325,7 @@ begin
|
||||
Add('BYTE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('VARIANT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
end;
|
||||
// functions
|
||||
WordIsPredefinedFPCIdentifier.Add(IsWordBuiltInFunc);
|
||||
|
||||
WordIsPredefinedDelphiIdentifier:=TKeyWordFunctionList.Create;
|
||||
|
||||
@ -1,25 +1,24 @@
|
||||
object ExtractProcDialog: TExtractProcDialog
|
||||
Left = 378
|
||||
Height = 201
|
||||
Height = 355
|
||||
Top = 374
|
||||
Width = 420
|
||||
HorzScrollBar.Page = 419
|
||||
VertScrollBar.Page = 200
|
||||
Width = 425
|
||||
HorzScrollBar.Page = 424
|
||||
VertScrollBar.Page = 354
|
||||
ActiveControl = NameEdit
|
||||
BorderIcons = [biSystemMenu]
|
||||
Caption = 'ExtractProcDialog'
|
||||
ClientHeight = 201
|
||||
ClientWidth = 420
|
||||
ClientHeight = 355
|
||||
ClientWidth = 425
|
||||
OnClose = ExtractProcDialogClose
|
||||
OnCreate = ExtractProcDialogCREATE
|
||||
object TypeRadiogroup: TRadioGroup
|
||||
AnchorSideBottom.Control = NameGroupbox
|
||||
Left = 6
|
||||
Height = 91
|
||||
Height = 171
|
||||
Top = 6
|
||||
Width = 408
|
||||
Align = alTop
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
Width = 413
|
||||
Align = alClient
|
||||
AutoFill = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'TypeRadiogroup'
|
||||
@ -42,86 +41,110 @@ object ExtractProcDialog: TExtractProcDialog
|
||||
AnchorSideBottom.Control = CancelButton
|
||||
Left = 6
|
||||
Height = 54
|
||||
Top = 103
|
||||
Width = 408
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
Top = 183
|
||||
Width = 413
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'NameGroupbox'
|
||||
ClientHeight = 35
|
||||
ClientWidth = 404
|
||||
ClientWidth = 409
|
||||
ParentCtl3D = False
|
||||
TabOrder = 0
|
||||
object NameEdit: TEdit
|
||||
Left = 6
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 392
|
||||
Width = 397
|
||||
Align = alTop
|
||||
BorderSpacing.Around = 6
|
||||
TabOrder = 0
|
||||
Text = 'NameEdit'
|
||||
end
|
||||
end
|
||||
object HelpButton: TBitBtn
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 36
|
||||
Top = 159
|
||||
Width = 75
|
||||
Anchors = [akLeft, akBottom]
|
||||
object BtnPanel: TPanel
|
||||
Height = 48
|
||||
Top = 307
|
||||
Width = 425
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = '&Help'
|
||||
Constraints.MinHeight = 25
|
||||
Constraints.MinWidth = 75
|
||||
Kind = bkHelp
|
||||
NumGlyphs = 0
|
||||
OnClick = HelpButtonClick
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 48
|
||||
ClientWidth = 425
|
||||
TabOrder = 2
|
||||
object CancelButton: TBitBtn
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 341
|
||||
Height = 36
|
||||
Top = 6
|
||||
Width = 78
|
||||
Align = alRight
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Cancel = True
|
||||
Caption = 'Cancel'
|
||||
Constraints.MinHeight = 25
|
||||
Constraints.MinWidth = 75
|
||||
Kind = bkCancel
|
||||
ModalResult = 2
|
||||
NumGlyphs = 0
|
||||
TabOrder = 0
|
||||
end
|
||||
object OkButton: TBitBtn
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 260
|
||||
Height = 36
|
||||
Top = 6
|
||||
Width = 75
|
||||
Align = alRight
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = '&OK'
|
||||
Constraints.MinHeight = 25
|
||||
Constraints.MinWidth = 75
|
||||
Default = True
|
||||
Kind = bkOK
|
||||
ModalResult = 1
|
||||
NumGlyphs = 0
|
||||
OnClick = OkButtonCLICK
|
||||
TabOrder = 1
|
||||
end
|
||||
object HelpButton: TBitBtn
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 36
|
||||
Top = 6
|
||||
Width = 75
|
||||
Align = alLeft
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = '&Help'
|
||||
Constraints.MinHeight = 25
|
||||
Constraints.MinWidth = 75
|
||||
Kind = bkHelp
|
||||
NumGlyphs = 0
|
||||
OnClick = HelpButtonClick
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
object CancelButton: TBitBtn
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 336
|
||||
Height = 32
|
||||
Top = 163
|
||||
Width = 78
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
object MissingIdentifiersGroupBox: TGroupBox
|
||||
Left = 6
|
||||
Height = 58
|
||||
Top = 243
|
||||
Width = 413
|
||||
Align = alBottom
|
||||
BorderSpacing.Around = 6
|
||||
Cancel = True
|
||||
Caption = 'Cancel'
|
||||
Constraints.MinHeight = 25
|
||||
Constraints.MinWidth = 75
|
||||
Kind = bkCancel
|
||||
ModalResult = 2
|
||||
NumGlyphs = 0
|
||||
Caption = 'MissingIdentifiersGroupBox'
|
||||
ClientHeight = 39
|
||||
ClientWidth = 409
|
||||
TabOrder = 3
|
||||
end
|
||||
object OkButton: TBitBtn
|
||||
AnchorSideRight.Control = CancelButton
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 255
|
||||
Height = 36
|
||||
Top = 159
|
||||
Width = 75
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = '&OK'
|
||||
Constraints.MinHeight = 25
|
||||
Constraints.MinWidth = 75
|
||||
Default = True
|
||||
Kind = bkOK
|
||||
ModalResult = 1
|
||||
NumGlyphs = 0
|
||||
OnClick = OkButtonCLICK
|
||||
TabOrder = 4
|
||||
object MissingIdentifiersListBox: TListBox
|
||||
Height = 39
|
||||
Width = 409
|
||||
Align = alClient
|
||||
TabOrder = 0
|
||||
TopIndex = -1
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@ -2,47 +2,50 @@
|
||||
|
||||
LazarusResources.Add('TExtractProcDialog','FORMDATA',[
|
||||
'TPF0'#18'TExtractProcDialog'#17'ExtractProcDialog'#4'Left'#3'z'#1#6'Height'#3
|
||||
+#201#0#3'Top'#3'v'#1#5'Width'#3#164#1#18'HorzScrollBar.Page'#3#163#1#18'Vert'
|
||||
+'ScrollBar.Page'#3#200#0#13'ActiveControl'#7#8'NameEdit'#11'BorderIcons'#11
|
||||
+#12'biSystemMenu'#0#7'Caption'#6#17'ExtractProcDialog'#12'ClientHeight'#3#201
|
||||
+#0#11'ClientWidth'#3#164#1#7'OnClose'#7#22'ExtractProcDialogClose'#8'OnCreat'
|
||||
+'e'#7#23'ExtractProcDialogCREATE'#0#11'TRadioGroup'#14'TypeRadiogroup'#24'An'
|
||||
+'chorSideBottom.Control'#7#12'NameGroupbox'#4'Left'#2#6#6'Height'#2'['#3'Top'
|
||||
+#2#6#5'Width'#3#152#1#5'Align'#7#5'alTop'#7'Anchors'#11#5'akTop'#6'akLeft'#7
|
||||
+'akRight'#8'akBottom'#0#8'AutoFill'#9#20'BorderSpacing.Around'#2#6#7'Caption'
|
||||
+#6#14'TypeRadiogroup'#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.To'
|
||||
+'pBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChi'
|
||||
+'ldResize'#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28
|
||||
+'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVer'
|
||||
+'tical'#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclTopToBottomThenL'
|
||||
+'eftToRight'#27'ChildSizing.ControlsPerLine'#2#1#12'ColumnLayout'#7#24'clVer'
|
||||
+'ticalThenHorizontal'#8'TabOrder'#2#1#0#0#9'TGroupBox'#12'NameGroupbox'#22'A'
|
||||
+'nchorSideLeft.Control'#7#5'Owner'#18'AnchorSideTop.Side'#7#9'asrBottom'#23
|
||||
+'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'asrBottom'
|
||||
+#24'AnchorSideBottom.Control'#7#12'CancelButton'#4'Left'#2#6#6'Height'#2'6'#3
|
||||
+'Top'#2'g'#5'Width'#3#152#1#7'Anchors'#11#6'akLeft'#7'akRight'#8'akBottom'#0
|
||||
+#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#12'NameGroupbox'#12
|
||||
+'ClientHeight'#2'#'#11'ClientWidth'#3#148#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#136
|
||||
+#1#5'Align'#7#5'alTop'#20'BorderSpacing.Around'#2#6#8'TabOrder'#2#0#4'Text'#6
|
||||
+#8'NameEdit'#0#0#0#7'TBitBtn'#10'HelpButton'#22'AnchorSideLeft.Control'#7#5
|
||||
+'Owner'#24'AnchorSideBottom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9
|
||||
+'asrBottom'#4'Left'#2#6#6'Height'#2'$'#3'Top'#3#159#0#5'Width'#2'K'#7'Anchor'
|
||||
+'s'#11#6'akLeft'#8'akBottom'#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7
|
||||
+'Caption'#6#5'&Help'#21'Constraints.MinHeight'#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#7'TBitBtn'#12'CancelButton'#23'AnchorSideRight.Control'#7
|
||||
+#5'Owner'#20'AnchorSideRight.Side'#7#9'asrBottom'#24'AnchorSideBottom.Contro'
|
||||
+'l'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3'P'#1#6'Hei'
|
||||
+'ght'#2' '#3'Top'#3#163#0#5'Width'#2'N'#7'Anchors'#11#7'akRight'#8'akBottom'
|
||||
+#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#6'Cancel'#9#7'Caption'#6#6'Can'
|
||||
+'cel'#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#3#0#0#7'TBit'
|
||||
+'Btn'#8'OkButton'#23'AnchorSideRight.Control'#7#12'CancelButton'#24'AnchorSi'
|
||||
+'deBottom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Lef'
|
||||
+'t'#3#255#0#6'Height'#2'$'#3'Top'#3#159#0#5'Width'#2'K'#7'Anchors'#11#7'akRi'
|
||||
+'ght'#8'akBottom'#0#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'ModalResult'#2#1#9'NumGlyphs'#2#0#7'OnClick'#7#13'Ok'
|
||||
+'ButtonCLICK'#8'TabOrder'#2#4#0#0#0
|
||||
+'c'#1#3'Top'#3'v'#1#5'Width'#3#169#1#18'HorzScrollBar.Page'#3#168#1#18'VertS'
|
||||
+'crollBar.Page'#3'b'#1#13'ActiveControl'#7#8'NameEdit'#11'BorderIcons'#11#12
|
||||
+'biSystemMenu'#0#7'Caption'#6#17'ExtractProcDialog'#12'ClientHeight'#3'c'#1
|
||||
+#11'ClientWidth'#3#169#1#7'OnClose'#7#22'ExtractProcDialogClose'#8'OnCreate'
|
||||
+#7#23'ExtractProcDialogCREATE'#0#11'TRadioGroup'#14'TypeRadiogroup'#24'Ancho'
|
||||
+'rSideBottom.Control'#7#12'NameGroupbox'#4'Left'#2#6#6'Height'#3#171#0#3'Top'
|
||||
+#2#6#5'Width'#3#157#1#5'Align'#7#8'alClient'#8'AutoFill'#9#20'BorderSpacing.'
|
||||
+'Around'#2#6#7'Caption'#6#14'TypeRadiogroup'#28'ChildSizing.LeftRightSpacing'
|
||||
+#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7
|
||||
+#24'crsHomogenousChildResize'#27'ChildSizing.EnlargeVertical'#7#24'crsHomoge'
|
||||
+'nousChildResize'#28'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'C'
|
||||
+'hildSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29
|
||||
+'cclTopToBottomThenLeftToRight'#27'ChildSizing.ControlsPerLine'#2#1#12'Colum'
|
||||
+'nLayout'#7#24'clVerticalThenHorizontal'#8'TabOrder'#2#1#0#0#9'TGroupBox'#12
|
||||
+'NameGroupbox'#22'AnchorSideLeft.Control'#7#5'Owner'#18'AnchorSideTop.Side'#7
|
||||
+#9'asrBottom'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'
|
||||
+#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#12'CancelButton'#4'Left'#2#6#6
|
||||
+'Height'#2'6'#3'Top'#3#183#0#5'Width'#3#157#1#5'Align'#7#8'alBottom'#8'AutoS'
|
||||
+'ize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#12'NameGroupbox'#12'Client'
|
||||
+'Height'#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
|
||||
+'NameEdit'#0#0#0#6'TPanel'#8'BtnPanel'#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
|
||||
+'ClientHeight'#2'0'#11'ClientWidth'#3#169#1#8'TabOrder'#2#2#0#7'TBitBtn'#12
|
||||
+'CancelButton'#20'AnchorSideRight.Side'#7#9'asrBottom'#21'AnchorSideBottom.S'
|
||||
+'ide'#7#9'asrBottom'#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'L'
|
||||
+'eft'#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'bkO'
|
||||
+'K'#11'ModalResult'#2#1#9'NumGlyphs'#2#0#7'OnClick'#7#13'OkButtonCLICK'#8'Ta'
|
||||
+'bOrder'#2#1#0#0#7'TBitBtn'#10'HelpButton'#21'AnchorSideBottom.Side'#7#9'asr'
|
||||
+'Bottom'#4'Left'#2#6#6'Height'#2'$'#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#6'al'
|
||||
+'Left'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#5'&Help'#21'C'
|
||||
+'onstraints.MinHeight'#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'T'
|
||||
+'GroupBox'#26'MissingIdentifiersGroupBox'#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'MissingIdentifiersGroupBox'#12'ClientHeight'#2''''#11'ClientW'
|
||||
+'idth'#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#8'Top'
|
||||
+'Index'#2#255#0#0#0#0
|
||||
]);
|
||||
|
||||
@ -1,3 +1,30 @@
|
||||
{
|
||||
***************************************************************************
|
||||
* *
|
||||
* This source is free software; you can redistribute it and/or modify *
|
||||
* it under the terms of the GNU General Public License as published by *
|
||||
* the Free Software Foundation; either version 2 of the License, or *
|
||||
* (at your option) any later version. *
|
||||
* *
|
||||
* This code is distributed in the hope that it will be useful, but *
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
||||
* General Public License for more details. *
|
||||
* *
|
||||
* A copy of the GNU General Public License is available on the World *
|
||||
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
||||
* obtain it by writing to the Free Software Foundation, *
|
||||
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
||||
* *
|
||||
***************************************************************************
|
||||
|
||||
Author: Mattias Gaertner
|
||||
|
||||
Abstract:
|
||||
Dialog for the Extract Proc feature.
|
||||
Allows user choose what kind of procedure to create and shows missing
|
||||
identifiers.
|
||||
}
|
||||
unit ExtractProcDlg;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
@ -5,8 +32,9 @@ unit ExtractProcDlg;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
Buttons, StdCtrls, CodeCache, CodeToolManager, ExtractProcTool,
|
||||
Classes, SysUtils, AVL_Tree, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
ExtCtrls, Buttons, StdCtrls,
|
||||
BasicCodeTools, CodeAtom, CodeCache, CodeToolManager, ExtractProcTool,
|
||||
LazarusIDEStrConsts, IDEProcs, MiscOptions, IDEContextHelpEdit;
|
||||
|
||||
type
|
||||
@ -14,11 +42,14 @@ type
|
||||
{ TExtractProcDialog }
|
||||
|
||||
TExtractProcDialog = class(TForm)
|
||||
MissingIdentifiersListBox: TListBox;
|
||||
MissingIdentifiersGroupBox: TGroupBox;
|
||||
NameEdit: TEDIT;
|
||||
NameGroupbox: TGROUPBOX;
|
||||
OkButton: TBitBtn;
|
||||
CancelButton: TBitBtn;
|
||||
HelpButton: TBitBtn;
|
||||
BtnPanel: TPanel;
|
||||
TypeRadiogroup: TRADIOGROUP;
|
||||
procedure HelpButtonClick(Sender: TObject);
|
||||
procedure ExtractProcDialogCREATE(Sender: TObject);
|
||||
@ -27,13 +58,16 @@ type
|
||||
procedure OkButtonCLICK(Sender: TObject);
|
||||
private
|
||||
FMethodPossible: boolean;
|
||||
FMissingIdentifiers: TAVLTree;
|
||||
FSubProcSameLvlPossible: boolean;
|
||||
procedure SetMissingIdentifiers(const AValue: TAVLTree);
|
||||
public
|
||||
procedure UpdateAvailableTypes;
|
||||
function GetProcType: TExtractProcType;
|
||||
function GetProcName: string;
|
||||
property MethodPossible: boolean read FMethodPossible write FMethodPossible;
|
||||
property SubProcSameLvlPossible: boolean read FSubProcSameLvlPossible write FSubProcSameLvlPossible;
|
||||
property MissingIdentifiers: TAVLTree read FMissingIdentifiers write SetMissingIdentifiers;
|
||||
end;
|
||||
|
||||
function ShowExtractProcDialog(Code: TCodeBuffer;
|
||||
@ -53,6 +87,7 @@ var
|
||||
SubProcSameLvlPossible: boolean;
|
||||
ProcName: String;
|
||||
ProcType: TExtractProcType;
|
||||
MissingIdentifiers: TAVLTree;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
if CompareCaret(BlockBegin,BlockEnd)<=0 then begin
|
||||
@ -61,42 +96,47 @@ begin
|
||||
mtInformation,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
// check if selected statements can be extracted
|
||||
MethodPossible:=false;
|
||||
SubProcSameLvlPossible:=false;
|
||||
if not CodeToolBoss.CheckExtractProc(Code,BlockBegin,BlockEnd,MethodPossible,
|
||||
SubProcSameLvlPossible)
|
||||
then begin
|
||||
if CodeToolBoss.ErrorMessage='' then begin
|
||||
MessageDlg(lisInvalidSelection,
|
||||
Format(lisThisStatementCanNotBeExtractedPleaseSelectSomeCode, [#13]),
|
||||
mtInformation,[mbCancel],0);
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// ask user how to extract
|
||||
ExtractProcDialog:=TExtractProcDialog.Create(nil);
|
||||
MissingIdentifiers:=nil;
|
||||
try
|
||||
ExtractProcDialog.MethodPossible:=MethodPossible;
|
||||
ExtractProcDialog.SubProcSameLvlPossible:=SubProcSameLvlPossible;
|
||||
ExtractProcDialog.UpdateAvailableTypes;
|
||||
Result:=ExtractProcDialog.ShowModal;
|
||||
if Result<>mrOk then exit;
|
||||
ProcName:=ExtractProcDialog.GetProcName;
|
||||
ProcType:=ExtractProcDialog.GetProcType;
|
||||
finally
|
||||
ExtractProcDialog.Free;
|
||||
end;
|
||||
// check if selected statements can be extracted
|
||||
if not CodeToolBoss.CheckExtractProc(Code,BlockBegin,BlockEnd,MethodPossible,
|
||||
SubProcSameLvlPossible,MissingIdentifiers)
|
||||
then begin
|
||||
if CodeToolBoss.ErrorMessage='' then begin
|
||||
MessageDlg(lisInvalidSelection,
|
||||
Format(lisThisStatementCanNotBeExtractedPleaseSelectSomeCode, [#13]),
|
||||
mtInformation,[mbCancel],0);
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// extract procedure/method
|
||||
if not CodeToolBoss.ExtractProc(Code,BlockBegin,BlockEnd,ProcType,ProcName,
|
||||
NewSource,NewX,NewY,NewTopLine)
|
||||
then begin
|
||||
Result:=mrCancel;
|
||||
exit;
|
||||
// ask user how to extract
|
||||
ExtractProcDialog:=TExtractProcDialog.Create(nil);
|
||||
try
|
||||
ExtractProcDialog.MethodPossible:=MethodPossible;
|
||||
ExtractProcDialog.SubProcSameLvlPossible:=SubProcSameLvlPossible;
|
||||
ExtractProcDialog.MissingIdentifiers:=MissingIdentifiers;
|
||||
ExtractProcDialog.UpdateAvailableTypes;
|
||||
Result:=ExtractProcDialog.ShowModal;
|
||||
if Result<>mrOk then exit;
|
||||
ProcName:=ExtractProcDialog.GetProcName;
|
||||
ProcType:=ExtractProcDialog.GetProcType;
|
||||
finally
|
||||
ExtractProcDialog.Free;
|
||||
end;
|
||||
|
||||
// extract procedure/method
|
||||
if not CodeToolBoss.ExtractProc(Code,BlockBegin,BlockEnd,ProcType,ProcName,
|
||||
MissingIdentifiers,NewSource,NewX,NewY,NewTopLine)
|
||||
then begin
|
||||
Result:=mrCancel;
|
||||
exit;
|
||||
end;
|
||||
Result:=mrOk;
|
||||
finally
|
||||
CodeToolBoss.FreeTreeOfPCodeXYPosition(MissingIdentifiers);
|
||||
end;
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
{ TExtractProcDialog }
|
||||
@ -105,10 +145,12 @@ procedure TExtractProcDialog.ExtractProcDialogCREATE(Sender: TObject);
|
||||
begin
|
||||
Caption:=lisExtractProcedure;
|
||||
NameGroupbox.Caption:=lisNameOfNewProcedure;
|
||||
OkButton.Caption:=lisExtract;
|
||||
CancelButton.Caption:=dlgCancel;
|
||||
TypeRadiogroup.Caption:=dlgEnvType;
|
||||
NameEdit.Text:=MiscellaneousOptions.ExtractProcName;
|
||||
MissingIdentifiersGroupBox.Caption:='Missing identifiers';
|
||||
|
||||
OkButton.Caption:=lisExtract;
|
||||
CancelButton.Caption:=dlgCancel;
|
||||
end;
|
||||
|
||||
procedure TExtractProcDialog.HelpButtonClick(Sender: TObject);
|
||||
@ -136,6 +178,38 @@ begin
|
||||
ModalResult:=mrOk;
|
||||
end;
|
||||
|
||||
procedure TExtractProcDialog.SetMissingIdentifiers(const AValue: TAVLTree);
|
||||
var
|
||||
Node: TAVLTreeNode;
|
||||
CodePos: PCodeXYPosition;
|
||||
p: integer;
|
||||
Identifier: string;
|
||||
s: String;
|
||||
begin
|
||||
if AValue=FMissingIdentifiers then exit;
|
||||
FMissingIdentifiers:=AValue;
|
||||
MissingIdentifiersListBox.Items.BeginUpdate;
|
||||
MissingIdentifiersListBox.Items.Clear;
|
||||
if FMissingIdentifiers<>nil then begin
|
||||
Node:=FMissingIdentifiers.FindLowest;
|
||||
while Node<>nil do begin
|
||||
CodePos:=PCodeXYPosition(Node.Data);
|
||||
CodePos^.Code.LineColToPosition(CodePos^.Y,CodePos^.X,p);
|
||||
if p>=1 then
|
||||
Identifier:=GetIdentifier(@CodePos^.Code.Source[p])
|
||||
else
|
||||
Identifier:='?';
|
||||
s:=Identifier+' at '+IntToStr(CodePos^.Y)+','+IntToStr(CodePos^.X);
|
||||
MissingIdentifiersListBox.Items.Add(s);
|
||||
Node:=FMissingIdentifiers.FindSuccessor(Node);
|
||||
end;
|
||||
end;
|
||||
MissingIdentifiersListBox.Items.EndUpdate;
|
||||
|
||||
// show/hide the MissingIdentifiersGroupBox
|
||||
MissingIdentifiersGroupBox.Visible:=MissingIdentifiersListBox.Items.Count>0;
|
||||
end;
|
||||
|
||||
procedure TExtractProcDialog.UpdateAvailableTypes;
|
||||
begin
|
||||
with TypeRadiogroup.Items do begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user