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

coetools: extract proc: implemented collecting and ingnoring missing identifiers

Browse Source 
git-svn-id: trunk@13559 -
This commit is contained in:
mattias 2008-01-01 19:35:37 +00:00
parent f67db8d99a
commit fd8a3de7c9
7 changed files with 618 additions and 405 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
components/codetools/codeatom.pas
View File

@ -39,7 +39,7 @@ uses
{$IFDEF MEM_CHECK} {$IFDEF MEM_CHECK}
MemCheck, MemCheck,
{$ENDIF} {$ENDIF}
Classes, SysUtils, FileProcs, CodeCache, KeywordFuncLists; Classes, SysUtils, FileProcs, AVL_Tree, CodeCache, KeywordFuncLists;
type type
TCodePosition = record TCodePosition = record
@ -152,6 +152,13 @@ function IndexOfCodePosition(var ListOfPCodeXYPosition: TFPList;
const APosition: PCodeXYPosition): integer; const APosition: PCodeXYPosition): integer;
procedure FreeListOfPCodeXYPosition(ListOfPCodeXYPosition: TFPList); 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 var
WordToAtomFlag: TWordToAtomFlag; WordToAtomFlag: TWordToAtomFlag;
@ -244,6 +251,67 @@ begin
ListOfPCodeXYPosition.Free; ListOfPCodeXYPosition.Free;
end; 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; function DbgsCXY(const p: TCodeXYPosition): string;
begin begin
if p.Code=nil then if p.Code=nil then

54
components/codetools/codetoolmanager.pas
View File

@ -480,9 +480,12 @@ type
// extract proc (creates a new procedure from code in selection) // extract proc (creates a new procedure from code in selection)
function CheckExtractProc(Code: TCodeBuffer; function CheckExtractProc(Code: TCodeBuffer;
const StartPoint, EndPoint: TPoint; const StartPoint, EndPoint: TPoint;
var MethodPossible, SubProcSameLvlPossible: boolean): boolean; out MethodPossible, SubProcSameLvlPossible: boolean;
out MissingIdentifiers: TAVLTree // tree of PCodeXYPosition
): boolean;
function ExtractProc(Code: TCodeBuffer; const StartPoint, EndPoint: TPoint; function ExtractProc(Code: TCodeBuffer; const StartPoint, EndPoint: TPoint;
ProcType: TExtractProcType; const ProcName: string; 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
): boolean; ): boolean;
@ -1409,52 +1412,20 @@ begin
end; end;
procedure TCodeToolManager.FreeTreeOfPCodeXYPosition(var Tree: TAVLTree); procedure TCodeToolManager.FreeTreeOfPCodeXYPosition(var Tree: TAVLTree);
var
ANode: TAVLTreeNode;
CursorPos: PCodeXYPosition;
begin begin
if Tree=nil then exit; CodeAtom.FreeTreeOfPCodeXYPosition(Tree);
ANode:=Tree.FindLowest; Tree:=nil;
while ANode<>nil do begin
CursorPos:=PCodeXYPosition(ANode.Data);
if CursorPos<>nil then
Dispose(CursorPos);
ANode:=Tree.FindSuccessor(ANode);
end;
Tree.Free;
end; end;
function TCodeToolManager.CreateTreeOfPCodeXYPosition: TAVLTree; function TCodeToolManager.CreateTreeOfPCodeXYPosition: TAVLTree;
begin begin
Result:=TAVLTree.Create(TListSortCompare(@CompareCodeXYPositions)); Result:=CodeAtom.CreateTreeOfPCodeXYPosition;
end; end;
procedure TCodeToolManager.AddListToTreeOfPCodeXYPosition(SrcList: TFPList; procedure TCodeToolManager.AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
DestTree: TAVLTree; ClearList, CreateCopies: boolean); DestTree: TAVLTree; ClearList, CreateCopies: boolean);
var
i: Integer;
CodePos: PCodeXYPosition;
NewCodePos: PCodeXYPosition;
begin begin
if SrcList=nil then exit; CodeAtom.AddListToTreeOfPCodeXYPosition(SrcList,DestTree,ClearList,CreateCopies);
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; end;
function TCodeToolManager.Explore(Code: TCodeBuffer; function TCodeToolManager.Explore(Code: TCodeBuffer;
@ -3350,7 +3321,9 @@ begin
end; end;
function TCodeToolManager.CheckExtractProc(Code: TCodeBuffer; const StartPoint, 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 var
StartPos, EndPos: TCodeXYPosition; StartPos, EndPos: TCodeXYPosition;
begin begin
@ -3367,7 +3340,7 @@ begin
EndPos.Code:=Code; EndPos.Code:=Code;
try try
Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible, Result:=FCurCodeTool.CheckExtractProc(StartPos,EndPos,MethodPossible,
SubProcSameLvlPossible); SubProcSameLvlPossible,MissingIdentifiers);
except except
on e: Exception do Result:=HandleException(e); on e: Exception do Result:=HandleException(e);
end; end;
@ -3375,6 +3348,7 @@ end;
function TCodeToolManager.ExtractProc(Code: TCodeBuffer; const StartPoint, function TCodeToolManager.ExtractProc(Code: TCodeBuffer; const StartPoint,
EndPoint: TPoint; ProcType: TExtractProcType; const ProcName: string; 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): boolean;
var var
StartPos, EndPos: TCodeXYPosition; StartPos, EndPos: TCodeXYPosition;
@ -3393,7 +3367,7 @@ begin
EndPos.Code:=Code; EndPos.Code:=Code;
try try
Result:=FCurCodeTool.ExtractProc(StartPos,EndPos,ProcType,ProcName, Result:=FCurCodeTool.ExtractProc(StartPos,EndPos,ProcType,ProcName,
NewPos,NewTopLine,SourceChangeCache); IgnoreIdentifiers,NewPos,NewTopLine,SourceChangeCache);
if Result then begin if Result then begin
NewX:=NewPos.X; NewX:=NewPos.X;
NewY:=NewPos.Y; NewY:=NewPos.Y;

492
components/codetools/extractproctool.pas
View File

@ -43,6 +43,7 @@ interface
uses uses
Classes, SysUtils, FileProcs, CodeToolsStrConsts, CodeTree, CodeAtom, Classes, SysUtils, FileProcs, CodeToolsStrConsts, CodeTree, CodeAtom,
CustomCodeTool,
PascalParserTool, CodeCompletionTool, KeywordFuncLists, BasicCodeTools, PascalParserTool, CodeCompletionTool, KeywordFuncLists, BasicCodeTools,
LinkScanner, AVL_Tree, SourceChanger, LinkScanner, AVL_Tree, SourceChanger,
FindDeclarationTool; FindDeclarationTool;
@ -62,11 +63,24 @@ type
); );
TExtractProcTool = class(TCodeCompletionCodeTool) 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 public
function CheckExtractProc(const StartPos, EndPos: TCodeXYPosition; 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; function ExtractProc(const StartPos, EndPos: TCodeXYPosition;
ProcType: TExtractProcType; const ProcName: string; ProcType: TExtractProcType; const ProcName: string;
IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
out NewPos: TCodeXYPosition; out NewTopLine: integer; out NewPos: TCodeXYPosition; out NewTopLine: integer;
SourceChangeCache: TSourceChangeCache): boolean; SourceChangeCache: TSourceChangeCache): boolean;
end; end;
@ -141,9 +155,9 @@ end;
{ TExtractProcTool } { TExtractProcTool }
function TExtractProcTool.CheckExtractProc(const StartPos, function TExtractProcTool.InitExtractProc(const StartPos,
EndPos: TCodeXYPosition; EndPos: TCodeXYPosition;
var MethodPossible, SubProcSameLvlPossible: boolean): boolean; out MethodPossible, SubProcSameLvlPossible: boolean): boolean;
var var
CleanStartPos, CleanEndPos: integer; CleanStartPos, CleanEndPos: integer;
CursorNode: TCodeTreeNode; CursorNode: TCodeTreeNode;
@ -157,15 +171,15 @@ begin
MethodPossible:=false; MethodPossible:=false;
SubProcSameLvlPossible:=false; SubProcSameLvlPossible:=false;
{$IFDEF CTDebug} {$IFDEF CTDebug}
DebugLn('TExtractProcTool.CheckExtractProc syntax and cursor check ..'); DebugLn('TExtractProcTool.InitExtractProc syntax and cursor check ..');
{$ENDIF} {$ENDIF}
// check syntax // check syntax
BuildTreeAndGetCleanPos(trAll,StartPos,CleanStartPos,[]); BuildTreeAndGetCleanPos(trAll,StartPos,CleanStartPos,[]);
if CaretToCleanPos(EndPos,CleanEndPos)<>0 then exit; if CaretToCleanPos(EndPos,CleanEndPos)<>0 then exit;
if CleanStartPos>=CleanEndPos then exit; if CleanStartPos>=CleanEndPos then exit;
{$IFDEF CTDebug} {$IFDEF CTDebug}
debugln('TExtractProcTool.CheckExtractProc Selection="',copy(Src,CleanStartPos,CleanEndPos-CleanStartPos),'"'); debugln('TExtractProcTool.InitExtractProc Selection="',copy(Src,CleanStartPos,CleanEndPos-CleanStartPos),'"');
DebugLn('TExtractProcTool.CheckExtractProc node check ..'); DebugLn('TExtractProcTool.InitExtractProc node check ..');
{$ENDIF} {$ENDIF}
// check if in a Begin..End block // check if in a Begin..End block
CursorNode:=FindDeepestNodeAtPos(CleanStartPos,true); CursorNode:=FindDeepestNodeAtPos(CleanStartPos,true);
@ -173,7 +187,7 @@ begin
BeginBlockNode:=CursorNode.GetNodeOfType(ctnBeginBlock); BeginBlockNode:=CursorNode.GetNodeOfType(ctnBeginBlock);
if BeginBlockNode=nil then exit; if BeginBlockNode=nil then exit;
{$IFDEF CTDebug} {$IFDEF CTDebug}
DebugLn('TExtractProcTool.CheckExtractProc Start/End check ..'); DebugLn('TExtractProcTool.InitExtractProc Start/End check ..');
{$ENDIF} {$ENDIF}
// check if Start and End on same block level // check if Start and End on same block level
MoveCursorToNodeStart(CursorNode); MoveCursorToNodeStart(CursorNode);
@ -183,16 +197,16 @@ begin
if (CurPos.EndPos>CleanEndPos) or (CurPos.StartPos>SrcLen) if (CurPos.EndPos>CleanEndPos) or (CurPos.StartPos>SrcLen)
or (CurPos.StartPos>CursorNode.EndPos) then or (CurPos.StartPos>CursorNode.EndPos) then
break; break;
//debugln('TExtractProcTool.CheckExtractProc A "',GetAtom,'"'); //debugln('TExtractProcTool.InitExtractProc A "',GetAtom,'"');
if WordIsBlockStatementStart.DoItUpperCase(UpperSrc, if WordIsBlockStatementStart.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then begin then begin
//debugln('TExtractProcTool.CheckExtractProc WordIsBlockStatementStart "',GetAtom,'"'); //debugln('TExtractProcTool.InitExtractProc WordIsBlockStatementStart "',GetAtom,'"');
BlockCleanStart:=CurPos.StartPos; BlockCleanStart:=CurPos.StartPos;
if not ReadTilBlockStatementEnd(true) then exit; if not ReadTilBlockStatementEnd(true) then exit;
BlockCleanEnd:=CurPos.EndPos; BlockCleanEnd:=CurPos.EndPos;
debugln(copy(Src,BlockCleanStart,BlockCleanEnd-BlockCleanStart)); 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 if BlockCleanStart<CleanStartPos then begin
// this block started outside the selection // this block started outside the selection
// -> it should end outside // -> it should end outside
@ -214,7 +228,7 @@ begin
exit; exit;
end; end;
end; end;
//debugln('TExtractProcTool.CheckExtractProc Block ok'); //debugln('TExtractProcTool.InitExtractProc Block ok');
end end
else if WordIsBlockStatementEnd.DoItUpperCase(UpperSrc, else if WordIsBlockStatementEnd.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
@ -234,7 +248,7 @@ begin
// check if end not in a statement // check if end not in a statement
// ToDo // ToDo
{$IFDEF CTDebug} {$IFDEF CTDebug}
DebugLn('TExtractProcTool.CheckExtractProc Method check ..'); DebugLn('TExtractProcTool.InitExtractProc Method check ..');
{$ENDIF} {$ENDIF}
// check if in a method body // check if in a method body
ANode:=CursorNode; ANode:=CursorNode;
@ -250,216 +264,46 @@ begin
end; end;
SubProcSameLvlPossible:=(ProcLvl>1); SubProcSameLvlPossible:=(ProcLvl>1);
{$IFDEF CTDebug} {$IFDEF CTDebug}
DebugLn('TExtractProcTool.CheckExtractProc END'); DebugLn('TExtractProcTool.InitExtractProc END');
{$ENDIF} {$ENDIF}
Result:=true; Result:=true;
end; 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; function TExtractProcTool.ExtractProc(const StartPos, EndPos: TCodeXYPosition;
ProcType: TExtractProcType; const ProcName: string; ProcType: TExtractProcType; const ProcName: string;
IgnoreIdentifiers: TAVLTree; // tree of PCodeXYPosition
out NewPos: TCodeXYPosition; out NewTopLine: integer; out NewPos: TCodeXYPosition; out NewTopLine: integer;
SourceChangeCache: TSourceChangeCache): boolean; SourceChangeCache: TSourceChangeCache): boolean;
type
TParameterType = (ptNone, ptConst, ptVar, ptOut, ptNoSpecifier);
const const
ShortProcFormat = [phpWithoutClassKeyword]; ShortProcFormat = [phpWithoutClassKeyword];
{$IFDEF CTDebug} {$IFDEF CTDebug}
ParameterTypeNames: array[TParameterType] of string = ( ParameterTypeNames: array[TParameterType] of string = (
'ptNone', 'ptConst', 'ptVar', 'ptOut', 'ptNoSpecifier'); 'ptNone', 'ptConst', 'ptVar', 'ptOut', 'ptNoSpecifier');
{$ENDIF} {$ENDIF}
type
TParameterType = (ptNone, ptConst, ptVar, ptOut, ptNoSpecifier);
var var
BlockStartPos, BlockEndPos: integer; // the selection BlockStartPos, BlockEndPos: integer; // the selection
ProcNode: TCodeTreeNode; // the main proc node of the selection ProcNode: TCodeTreeNode; // the main proc node of the selection
VarTree: TAVLTree; 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; function ReplaceSelectionWithCall: boolean;
var var
Indent: Integer; Indent: Integer;
@ -1154,12 +998,10 @@ var
ProcCode: string; ProcCode: string;
begin begin
Result:=false; Result:=false;
MethodPossible:=false;
SubProcSameLvlPossible:=false;
{$IFDEF CTDebug} {$IFDEF CTDebug}
DebugLn('ExtractProc A ProcName="',ProcName,'" ProcType=',ExtractProcTypeNames[ProcType]); DebugLn('ExtractProc A ProcName="',ProcName,'" ProcType=',ExtractProcTypeNames[ProcType]);
{$ENDIF} {$ENDIF}
if not CheckExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible) if not InitExtractProc(StartPos,EndPos,MethodPossible,SubProcSameLvlPossible)
then exit; then exit;
if (not MethodPossible) and (ProcType in [eptPrivateMethod,eptProtectedMethod, if (not MethodPossible) and (ProcType in [eptPrivateMethod,eptProtectedMethod,
eptPublicMethod,eptPublishedMethod]) eptPublicMethod,eptPublishedMethod])
@ -1167,16 +1009,13 @@ begin
exit; exit;
if (not SubProcSameLvlPossible) and (ProcType=eptSubProcedureSameLvl) then if (not SubProcSameLvlPossible) and (ProcType=eptSubProcedureSameLvl) then
exit; exit;
if CaretToCleanPos(StartPos,BlockStartPos)<>0 then exit;
if CaretToCleanPos(EndPos,BlockEndPos)<>0 then exit;
BuildSubTree(BlockStartPos);
CodeCompleteSrcChgCache:=SourceChangeCache; CodeCompleteSrcChgCache:=SourceChangeCache;
ProcNode:=FindDeepestNodeAtPos(BlockStartPos,true).GetNodeOfType(ctnProcedure);
VarTree:=nil; VarTree:=TAVLTree.Create(TListSortCompare(@CompareExtractedProcVariables));
NewProcPath:=nil; NewProcPath:=nil;
try 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 ReplaceSelectionWithCall then exit;
if not DeleteMovedLocalVariables then exit; if not DeleteMovedLocalVariables then exit;
if not CreateProcNameParts(ProcClassName,ProcClassNode) then exit; if not CreateProcNameParts(ProcClassName,ProcClassNode) then exit;
@ -1205,5 +1044,234 @@ begin
Result:=true; Result:=true;
end; 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. end.

5
components/codetools/keywordfunclists.pas
View File

@ -933,7 +933,7 @@ begin
Add('LO' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('LO' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('HI' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('HI' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ORD' ,{$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('SUCC' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('LENGTH' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('LENGTH' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SETLENGTH' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('SETLENGTH' ,{$ifdef FPC}@{$endif}AllwaysTrue);
@ -954,6 +954,8 @@ begin
Add('EXIT' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('EXIT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('BREAK' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('BREAK' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CONTINUE' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('CONTINUE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('NEW' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('DISPOSE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
end; end;
WordIsTermOperator:=TKeyWordFunctionList.Create; WordIsTermOperator:=TKeyWordFunctionList.Create;
@ -1323,6 +1325,7 @@ begin
Add('BYTE' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('BYTE' ,{$ifdef FPC}@{$endif}AllwaysTrue);
Add('VARIANT' ,{$ifdef FPC}@{$endif}AllwaysTrue); Add('VARIANT' ,{$ifdef FPC}@{$endif}AllwaysTrue);
end; end;
// functions
WordIsPredefinedFPCIdentifier.Add(IsWordBuiltInFunc); WordIsPredefinedFPCIdentifier.Add(IsWordBuiltInFunc);
WordIsPredefinedDelphiIdentifier:=TKeyWordFunctionList.Create; WordIsPredefinedDelphiIdentifier:=TKeyWordFunctionList.Create;

113
ide/extractprocdlg.lfm
View File

@ -1,25 +1,24 @@
object ExtractProcDialog: TExtractProcDialog object ExtractProcDialog: TExtractProcDialog
Left = 378 Left = 378
Height = 201 Height = 355
Top = 374 Top = 374
Width = 420 Width = 425
HorzScrollBar.Page = 419 HorzScrollBar.Page = 424
VertScrollBar.Page = 200 VertScrollBar.Page = 354
ActiveControl = NameEdit ActiveControl = NameEdit
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
Caption = 'ExtractProcDialog' Caption = 'ExtractProcDialog'
ClientHeight = 201 ClientHeight = 355
ClientWidth = 420 ClientWidth = 425
OnClose = ExtractProcDialogClose OnClose = ExtractProcDialogClose
OnCreate = ExtractProcDialogCREATE OnCreate = ExtractProcDialogCREATE
object TypeRadiogroup: TRadioGroup object TypeRadiogroup: TRadioGroup
AnchorSideBottom.Control = NameGroupbox AnchorSideBottom.Control = NameGroupbox
Left = 6 Left = 6
Height = 91 Height = 171
Top = 6 Top = 6
Width = 408 Width = 413
Align = alTop Align = alClient
Anchors = [akTop, akLeft, akRight, akBottom]
AutoFill = True AutoFill = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'TypeRadiogroup' Caption = 'TypeRadiogroup'
@ -42,56 +41,45 @@ object ExtractProcDialog: TExtractProcDialog
AnchorSideBottom.Control = CancelButton AnchorSideBottom.Control = CancelButton
Left = 6 Left = 6
Height = 54 Height = 54
Top = 103 Top = 183
Width = 408 Width = 413
Anchors = [akLeft, akRight, akBottom] Align = alBottom
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'NameGroupbox' Caption = 'NameGroupbox'
ClientHeight = 35 ClientHeight = 35
ClientWidth = 404 ClientWidth = 409
ParentCtl3D = False ParentCtl3D = False
TabOrder = 0 TabOrder = 0
object NameEdit: TEdit object NameEdit: TEdit
Left = 6 Left = 6
Height = 23 Height = 23
Top = 6 Top = 6
Width = 392 Width = 397
Align = alTop Align = alTop
BorderSpacing.Around = 6 BorderSpacing.Around = 6
TabOrder = 0 TabOrder = 0
Text = 'NameEdit' Text = 'NameEdit'
end end
end end
object HelpButton: TBitBtn object BtnPanel: TPanel
AnchorSideLeft.Control = Owner Height = 48
AnchorSideBottom.Control = Owner Top = 307
AnchorSideBottom.Side = asrBottom Width = 425
Left = 6 Align = alBottom
Height = 36
Top = 159
Width = 75
Anchors = [akLeft, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BevelOuter = bvNone
Caption = '&Help' ClientHeight = 48
Constraints.MinHeight = 25 ClientWidth = 425
Constraints.MinWidth = 75
Kind = bkHelp
NumGlyphs = 0
OnClick = HelpButtonClick
TabOrder = 2 TabOrder = 2
end
object CancelButton: TBitBtn object CancelButton: TBitBtn
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 336 Left = 341
Height = 32 Height = 36
Top = 163 Top = 6
Width = 78 Width = 78
Anchors = [akRight, akBottom] Align = alRight
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Cancel = True Cancel = True
@ -101,17 +89,15 @@ object ExtractProcDialog: TExtractProcDialog
Kind = bkCancel Kind = bkCancel
ModalResult = 2 ModalResult = 2
NumGlyphs = 0 NumGlyphs = 0
TabOrder = 3 TabOrder = 0
end end
object OkButton: TBitBtn object OkButton: TBitBtn
AnchorSideRight.Control = CancelButton
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 255 Left = 260
Height = 36 Height = 36
Top = 159 Top = 6
Width = 75 Width = 75
Anchors = [akRight, akBottom] Align = alRight
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = '&OK' Caption = '&OK'
@ -122,6 +108,43 @@ object ExtractProcDialog: TExtractProcDialog
ModalResult = 1 ModalResult = 1
NumGlyphs = 0 NumGlyphs = 0
OnClick = OkButtonCLICK OnClick = OkButtonCLICK
TabOrder = 4 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 MissingIdentifiersGroupBox: TGroupBox
Left = 6
Height = 58
Top = 243
Width = 413
Align = alBottom
BorderSpacing.Around = 6
Caption = 'MissingIdentifiersGroupBox'
ClientHeight = 39
ClientWidth = 409
TabOrder = 3
object MissingIdentifiersListBox: TListBox
Height = 39
Width = 409
Align = alClient
TabOrder = 0
TopIndex = -1
end
end end
end end

89
ide/extractprocdlg.lrs
View File

@ -2,47 +2,50 @@
LazarusResources.Add('TExtractProcDialog','FORMDATA',[ LazarusResources.Add('TExtractProcDialog','FORMDATA',[
'TPF0'#18'TExtractProcDialog'#17'ExtractProcDialog'#4'Left'#3'z'#1#6'Height'#3 'TPF0'#18'TExtractProcDialog'#17'ExtractProcDialog'#4'Left'#3'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' +'c'#1#3'Top'#3'v'#1#5'Width'#3#169#1#18'HorzScrollBar.Page'#3#168#1#18'VertS'
+'ScrollBar.Page'#3#200#0#13'ActiveControl'#7#8'NameEdit'#11'BorderIcons'#11 +'crollBar.Page'#3'b'#1#13'ActiveControl'#7#8'NameEdit'#11'BorderIcons'#11#12
+#12'biSystemMenu'#0#7'Caption'#6#17'ExtractProcDialog'#12'ClientHeight'#3#201 +'biSystemMenu'#0#7'Caption'#6#17'ExtractProcDialog'#12'ClientHeight'#3'c'#1
+#0#11'ClientWidth'#3#164#1#7'OnClose'#7#22'ExtractProcDialogClose'#8'OnCreat' +#11'ClientWidth'#3#169#1#7'OnClose'#7#22'ExtractProcDialogClose'#8'OnCreate'
+'e'#7#23'ExtractProcDialogCREATE'#0#11'TRadioGroup'#14'TypeRadiogroup'#24'An' +#7#23'ExtractProcDialogCREATE'#0#11'TRadioGroup'#14'TypeRadiogroup'#24'Ancho'
+'chorSideBottom.Control'#7#12'NameGroupbox'#4'Left'#2#6#6'Height'#2'['#3'Top' +'rSideBottom.Control'#7#12'NameGroupbox'#4'Left'#2#6#6'Height'#3#171#0#3'Top'
+#2#6#5'Width'#3#152#1#5'Align'#7#5'alTop'#7'Anchors'#11#5'akTop'#6'akLeft'#7 +#2#6#5'Width'#3#157#1#5'Align'#7#8'alClient'#8'AutoFill'#9#20'BorderSpacing.'
+'akRight'#8'akBottom'#0#8'AutoFill'#9#20'BorderSpacing.Around'#2#6#7'Caption' +'Around'#2#6#7'Caption'#6#14'TypeRadiogroup'#28'ChildSizing.LeftRightSpacing'
+#6#14'TypeRadiogroup'#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.To' +#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7
+'pBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChi' +#24'crsHomogenousChildResize'#27'ChildSizing.EnlargeVertical'#7#24'crsHomoge'
+'ldResize'#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28 +'nousChildResize'#28'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'C'
+'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVer' +'hildSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29
+'tical'#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclTopToBottomThenL' +'cclTopToBottomThenLeftToRight'#27'ChildSizing.ControlsPerLine'#2#1#12'Colum'
+'eftToRight'#27'ChildSizing.ControlsPerLine'#2#1#12'ColumnLayout'#7#24'clVer' +'nLayout'#7#24'clVerticalThenHorizontal'#8'TabOrder'#2#1#0#0#9'TGroupBox'#12
+'ticalThenHorizontal'#8'TabOrder'#2#1#0#0#9'TGroupBox'#12'NameGroupbox'#22'A' +'NameGroupbox'#22'AnchorSideLeft.Control'#7#5'Owner'#18'AnchorSideTop.Side'#7
+'nchorSideLeft.Control'#7#5'Owner'#18'AnchorSideTop.Side'#7#9'asrBottom'#23 +#9'asrBottom'#23'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'
+'AnchorSideRight.Control'#7#5'Owner'#20'AnchorSideRight.Side'#7#9'asrBottom' +#7#9'asrBottom'#24'AnchorSideBottom.Control'#7#12'CancelButton'#4'Left'#2#6#6
+#24'AnchorSideBottom.Control'#7#12'CancelButton'#4'Left'#2#6#6'Height'#2'6'#3 +'Height'#2'6'#3'Top'#3#183#0#5'Width'#3#157#1#5'Align'#7#8'alBottom'#8'AutoS'
+'Top'#2'g'#5'Width'#3#152#1#7'Anchors'#11#6'akLeft'#7'akRight'#8'akBottom'#0 +'ize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#12'NameGroupbox'#12'Client'
+#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#12'NameGroupbox'#12 +'Height'#2'#'#11'ClientWidth'#3#153#1#11'ParentCtl3D'#8#8'TabOrder'#2#0#0#5
+'ClientHeight'#2'#'#11'ClientWidth'#3#148#1#11'ParentCtl3D'#8#8'TabOrder'#2#0 +'TEdit'#8'NameEdit'#4'Left'#2#6#6'Height'#2#23#3'Top'#2#6#5'Width'#3#141#1#5
+#0#5'TEdit'#8'NameEdit'#4'Left'#2#6#6'Height'#2#23#3'Top'#2#6#5'Width'#3#136 +'Align'#7#5'alTop'#20'BorderSpacing.Around'#2#6#8'TabOrder'#2#0#4'Text'#6#8
+#1#5'Align'#7#5'alTop'#20'BorderSpacing.Around'#2#6#8'TabOrder'#2#0#4'Text'#6 +'NameEdit'#0#0#0#6'TPanel'#8'BtnPanel'#6'Height'#2'0'#3'Top'#3'3'#1#5'Width'
+#8'NameEdit'#0#0#0#7'TBitBtn'#10'HelpButton'#22'AnchorSideLeft.Control'#7#5 +#3#169#1#5'Align'#7#8'alBottom'#8'AutoSize'#9#10'BevelOuter'#7#6'bvNone'#12
+'Owner'#24'AnchorSideBottom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9 +'ClientHeight'#2'0'#11'ClientWidth'#3#169#1#8'TabOrder'#2#2#0#7'TBitBtn'#12
+'asrBottom'#4'Left'#2#6#6'Height'#2'$'#3'Top'#3#159#0#5'Width'#2'K'#7'Anchor' +'CancelButton'#20'AnchorSideRight.Side'#7#9'asrBottom'#21'AnchorSideBottom.S'
+'s'#11#6'akLeft'#8'akBottom'#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7 +'ide'#7#9'asrBottom'#4'Left'#3'U'#1#6'Height'#2'$'#3'Top'#2#6#5'Width'#2'N'#5
+'Caption'#6#5'&Help'#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth' +'Align'#7#7'alRight'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#6'Cancel'#9#7
+#2'K'#4'Kind'#7#6'bkHelp'#9'NumGlyphs'#2#0#7'OnClick'#7#15'HelpButtonClick'#8 +'Caption'#6#6'Cancel'#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'
+'TabOrder'#2#2#0#0#7'TBitBtn'#12'CancelButton'#23'AnchorSideRight.Control'#7 +#2'K'#4'Kind'#7#8'bkCancel'#11'ModalResult'#2#2#9'NumGlyphs'#2#0#8'TabOrder'
+#5'Owner'#20'AnchorSideRight.Side'#7#9'asrBottom'#24'AnchorSideBottom.Contro' +#2#0#0#0#7'TBitBtn'#8'OkButton'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'L'
+'l'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#3'P'#1#6'Hei' +'eft'#3#4#1#6'Height'#2'$'#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#7'alRight'#8
+'ght'#2' '#3'Top'#3#163#0#5'Width'#2'N'#7'Anchors'#11#7'akRight'#8'akBottom' +'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#3'&OK'#21'Constraints'
+#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#6'Cancel'#9#7'Caption'#6#6'Can' +'.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#7'Default'#9#4'Kind'#7#4'bkO'
+'cel'#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#4'Kind'#7 +'K'#11'ModalResult'#2#1#9'NumGlyphs'#2#0#7'OnClick'#7#13'OkButtonCLICK'#8'Ta'
+#8'bkCancel'#11'ModalResult'#2#2#9'NumGlyphs'#2#0#8'TabOrder'#2#3#0#0#7'TBit' +'bOrder'#2#1#0#0#7'TBitBtn'#10'HelpButton'#21'AnchorSideBottom.Side'#7#9'asr'
+'Btn'#8'OkButton'#23'AnchorSideRight.Control'#7#12'CancelButton'#24'AnchorSi' +'Bottom'#4'Left'#2#6#6'Height'#2'$'#3'Top'#2#6#5'Width'#2'K'#5'Align'#7#6'al'
+'deBottom.Control'#7#5'Owner'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Lef' +'Left'#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#5'&Help'#21'C'
+'t'#3#255#0#6'Height'#2'$'#3'Top'#3#159#0#5'Width'#2'K'#7'Anchors'#11#7'akRi' +'onstraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#4'Kind'#7#6'bkHelp'
+'ght'#8'akBottom'#0#8'AutoSize'#9#20'BorderSpacing.Around'#2#6#7'Caption'#6#3 +#9'NumGlyphs'#2#0#7'OnClick'#7#15'HelpButtonClick'#8'TabOrder'#2#2#0#0#0#9'T'
+'&OK'#21'Constraints.MinHeight'#2#25#20'Constraints.MinWidth'#2'K'#7'Default' +'GroupBox'#26'MissingIdentifiersGroupBox'#4'Left'#2#6#6'Height'#2':'#3'Top'#3
+#9#4'Kind'#7#4'bkOK'#11'ModalResult'#2#1#9'NumGlyphs'#2#0#7'OnClick'#7#13'Ok' +#243#0#5'Width'#3#157#1#5'Align'#7#8'alBottom'#20'BorderSpacing.Around'#2#6#7
+'ButtonCLICK'#8'TabOrder'#2#4#0#0#0 +'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
]); ]);

90
ide/extractprocdlg.pas
View File

@ -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; unit ExtractProcDlg;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
@ -5,8 +32,9 @@ unit ExtractProcDlg;
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, Classes, SysUtils, AVL_Tree, LResources, Forms, Controls, Graphics, Dialogs,
Buttons, StdCtrls, CodeCache, CodeToolManager, ExtractProcTool, ExtCtrls, Buttons, StdCtrls,
BasicCodeTools, CodeAtom, CodeCache, CodeToolManager, ExtractProcTool,
LazarusIDEStrConsts, IDEProcs, MiscOptions, IDEContextHelpEdit; LazarusIDEStrConsts, IDEProcs, MiscOptions, IDEContextHelpEdit;
type type
@ -14,11 +42,14 @@ type
{ TExtractProcDialog } { TExtractProcDialog }
TExtractProcDialog = class(TForm) TExtractProcDialog = class(TForm)
MissingIdentifiersListBox: TListBox;
MissingIdentifiersGroupBox: TGroupBox;
NameEdit: TEDIT; NameEdit: TEDIT;
NameGroupbox: TGROUPBOX; NameGroupbox: TGROUPBOX;
OkButton: TBitBtn; OkButton: TBitBtn;
CancelButton: TBitBtn; CancelButton: TBitBtn;
HelpButton: TBitBtn; HelpButton: TBitBtn;
BtnPanel: TPanel;
TypeRadiogroup: TRADIOGROUP; TypeRadiogroup: TRADIOGROUP;
procedure HelpButtonClick(Sender: TObject); procedure HelpButtonClick(Sender: TObject);
procedure ExtractProcDialogCREATE(Sender: TObject); procedure ExtractProcDialogCREATE(Sender: TObject);
@ -27,13 +58,16 @@ type
procedure OkButtonCLICK(Sender: TObject); procedure OkButtonCLICK(Sender: TObject);
private private
FMethodPossible: boolean; FMethodPossible: boolean;
FMissingIdentifiers: TAVLTree;
FSubProcSameLvlPossible: boolean; FSubProcSameLvlPossible: boolean;
procedure SetMissingIdentifiers(const AValue: TAVLTree);
public public
procedure UpdateAvailableTypes; procedure UpdateAvailableTypes;
function GetProcType: TExtractProcType; function GetProcType: TExtractProcType;
function GetProcName: string; function GetProcName: string;
property MethodPossible: boolean read FMethodPossible write FMethodPossible; property MethodPossible: boolean read FMethodPossible write FMethodPossible;
property SubProcSameLvlPossible: boolean read FSubProcSameLvlPossible write FSubProcSameLvlPossible; property SubProcSameLvlPossible: boolean read FSubProcSameLvlPossible write FSubProcSameLvlPossible;
property MissingIdentifiers: TAVLTree read FMissingIdentifiers write SetMissingIdentifiers;
end; end;
function ShowExtractProcDialog(Code: TCodeBuffer; function ShowExtractProcDialog(Code: TCodeBuffer;
@ -53,6 +87,7 @@ var
SubProcSameLvlPossible: boolean; SubProcSameLvlPossible: boolean;
ProcName: String; ProcName: String;
ProcType: TExtractProcType; ProcType: TExtractProcType;
MissingIdentifiers: TAVLTree;
begin begin
Result:=mrCancel; Result:=mrCancel;
if CompareCaret(BlockBegin,BlockEnd)<=0 then begin if CompareCaret(BlockBegin,BlockEnd)<=0 then begin
@ -61,11 +96,12 @@ begin
mtInformation,[mbCancel],0); mtInformation,[mbCancel],0);
exit; exit;
end; end;
MissingIdentifiers:=nil;
try
// check if selected statements can be extracted // check if selected statements can be extracted
MethodPossible:=false;
SubProcSameLvlPossible:=false;
if not CodeToolBoss.CheckExtractProc(Code,BlockBegin,BlockEnd,MethodPossible, if not CodeToolBoss.CheckExtractProc(Code,BlockBegin,BlockEnd,MethodPossible,
SubProcSameLvlPossible) SubProcSameLvlPossible,MissingIdentifiers)
then begin then begin
if CodeToolBoss.ErrorMessage='' then begin if CodeToolBoss.ErrorMessage='' then begin
MessageDlg(lisInvalidSelection, MessageDlg(lisInvalidSelection,
@ -80,6 +116,7 @@ begin
try try
ExtractProcDialog.MethodPossible:=MethodPossible; ExtractProcDialog.MethodPossible:=MethodPossible;
ExtractProcDialog.SubProcSameLvlPossible:=SubProcSameLvlPossible; ExtractProcDialog.SubProcSameLvlPossible:=SubProcSameLvlPossible;
ExtractProcDialog.MissingIdentifiers:=MissingIdentifiers;
ExtractProcDialog.UpdateAvailableTypes; ExtractProcDialog.UpdateAvailableTypes;
Result:=ExtractProcDialog.ShowModal; Result:=ExtractProcDialog.ShowModal;
if Result<>mrOk then exit; if Result<>mrOk then exit;
@ -91,12 +128,15 @@ begin
// extract procedure/method // extract procedure/method
if not CodeToolBoss.ExtractProc(Code,BlockBegin,BlockEnd,ProcType,ProcName, if not CodeToolBoss.ExtractProc(Code,BlockBegin,BlockEnd,ProcType,ProcName,
NewSource,NewX,NewY,NewTopLine) MissingIdentifiers,NewSource,NewX,NewY,NewTopLine)
then begin then begin
Result:=mrCancel; Result:=mrCancel;
exit; exit;
end; end;
Result:=mrOk; Result:=mrOk;
finally
CodeToolBoss.FreeTreeOfPCodeXYPosition(MissingIdentifiers);
end;
end; end;
{ TExtractProcDialog } { TExtractProcDialog }
@ -105,10 +145,12 @@ procedure TExtractProcDialog.ExtractProcDialogCREATE(Sender: TObject);
begin begin
Caption:=lisExtractProcedure; Caption:=lisExtractProcedure;
NameGroupbox.Caption:=lisNameOfNewProcedure; NameGroupbox.Caption:=lisNameOfNewProcedure;
OkButton.Caption:=lisExtract;
CancelButton.Caption:=dlgCancel;
TypeRadiogroup.Caption:=dlgEnvType; TypeRadiogroup.Caption:=dlgEnvType;
NameEdit.Text:=MiscellaneousOptions.ExtractProcName; NameEdit.Text:=MiscellaneousOptions.ExtractProcName;
MissingIdentifiersGroupBox.Caption:='Missing identifiers';
OkButton.Caption:=lisExtract;
CancelButton.Caption:=dlgCancel;
end; end;
procedure TExtractProcDialog.HelpButtonClick(Sender: TObject); procedure TExtractProcDialog.HelpButtonClick(Sender: TObject);
@ -136,6 +178,38 @@ begin
ModalResult:=mrOk; ModalResult:=mrOk;
end; 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; procedure TExtractProcDialog.UpdateAvailableTypes;
begin begin
with TypeRadiogroup.Items do begin with TypeRadiogroup.Items do begin