mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 05:39:29 +02:00
IDE: added refactoring tool show abstract methods
git-svn-id: trunk@13212 -
This commit is contained in:
parent
65148452ac
commit
b27b9bb629
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -1792,6 +1792,9 @@ ide/Makefile.fpc svneol=native#text/plain
|
||||
ide/aboutfrm.lfm svneol=native#text/plain
|
||||
ide/aboutfrm.lrs svneol=native#text/pascal
|
||||
ide/aboutfrm.pas svneol=native#text/pascal
|
||||
ide/abstractsmethodsdlg.lfm svneol=native#text/plain
|
||||
ide/abstractsmethodsdlg.lrs svneol=native#text/plain
|
||||
ide/abstractsmethodsdlg.pas svneol=native#text/plain
|
||||
ide/addtoprojectdlg.lfm svneol=native#text/plain
|
||||
ide/addtoprojectdlg.lrs svneol=native#text/plain
|
||||
ide/addtoprojectdlg.pas svneol=native#text/pascal
|
||||
|
@ -1485,12 +1485,11 @@ begin
|
||||
ReadRawNextPascalAtom(ProcText,p,AtomStart,NestedComments);
|
||||
if AtomStart>length(ProcText) then exit;
|
||||
if ProcText[AtomStart] in ['[','('] then begin
|
||||
if not ReadTilPascalBracketClose(ProcText,AtomStart,NestedComments) then
|
||||
if not ReadTilPascalBracketClose(ProcText,p,NestedComments) then
|
||||
exit;
|
||||
p:=AtomStart;
|
||||
end else if ProcText[AtomStart]=';' then begin
|
||||
ReadRawNextPascalAtom(ProcText,p,AtomStart,NestedComments);
|
||||
Result:=p;
|
||||
Result:=AtomStart;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@ -1515,10 +1514,9 @@ begin
|
||||
break;
|
||||
end;
|
||||
if ProcText[AtomStart] in ['[','('] then begin
|
||||
if not ReadTilPascalBracketClose(ProcText,AtomStart,NestedComments)
|
||||
if not ReadTilPascalBracketClose(ProcText,Result,NestedComments)
|
||||
then
|
||||
exit(-1);
|
||||
Result:=AtomStart;
|
||||
end;
|
||||
end;
|
||||
SpecifierEndPosition:=Result;
|
||||
@ -1527,10 +1525,9 @@ begin
|
||||
ReadRawNextPascalAtom(ProcText,SpecifierEndPosition,AtomStart,NestedComments);
|
||||
if AtomStart>length(ProcText) then exit;
|
||||
if ProcText[AtomStart] in ['[','('] then begin
|
||||
if not ReadTilPascalBracketClose(ProcText,AtomStart,NestedComments)
|
||||
if not ReadTilPascalBracketClose(ProcText,SpecifierEndPosition,NestedComments)
|
||||
then
|
||||
exit(-1);
|
||||
SpecifierEndPosition:=AtomStart;
|
||||
end;
|
||||
end;
|
||||
if WithSpaceBehindSemicolon and (SpecifierEndPosition<=length(ProcText)) then
|
||||
@ -1538,6 +1535,7 @@ begin
|
||||
SpecifierEndPosition:=FindLineEndOrCodeAfterPosition(ProcText,
|
||||
SpecifierEndPosition+1,0,NestedComments);
|
||||
end;
|
||||
//DebugLn(['SearchProcSpecifier ',copy(ProcText,Result,SpecifierEndPosition-Result)]);
|
||||
end;
|
||||
|
||||
function RemoveProcSpecifier(const ProcText, Specifier: string;
|
||||
@ -1815,15 +1813,18 @@ begin
|
||||
AtomStart:=Position;
|
||||
while Position<=Len do begin
|
||||
ReadRawNextPascalAtom(Source,Position,AtomStart,NestedComments);
|
||||
//DebugLn(['ReadTilPascalBracketClose ',copy(Source,AtomStart,Position-AtomStart)]);
|
||||
if Position>Len then
|
||||
exit; // CloseBracket not found
|
||||
case Source[Position] of
|
||||
case Source[AtomStart] of
|
||||
'{','(','[':
|
||||
if not ReadTilPascalBracketClose(Source,Position) then exit;
|
||||
begin
|
||||
if not ReadTilPascalBracketClose(Source,AtomStart) then exit;
|
||||
Position:=AtomStart;
|
||||
end;
|
||||
'}',')',']':
|
||||
if Source[Position]=CloseBracket then begin
|
||||
if Source[AtomStart]=CloseBracket then begin
|
||||
// CloseBracket found
|
||||
inc(Position);
|
||||
Result:=true;
|
||||
exit;
|
||||
end else begin
|
||||
|
@ -121,7 +121,7 @@ type
|
||||
FirstInsert: TCodeTreeNodeExtension; // list of insert requests
|
||||
FOnGetNewVariableLocation: TOnGetNewVariableLocation;
|
||||
FSetPropertyVariablename: string;
|
||||
JumpToProcName: string;
|
||||
FJumpToProcName: string;
|
||||
NewClassSectionIndent: array[TPascalClassSection] of integer;
|
||||
NewClassSectionInsertPos: array[TPascalClassSection] of integer;
|
||||
fFullTopLvlName: string;// used by OnTopLvlIdentifierFound
|
||||
@ -142,6 +142,9 @@ type
|
||||
function InsertMissingClassSemicolons: boolean;
|
||||
function InsertAllNewUnitsToMainUsesSection: boolean;
|
||||
function CreateMissingProcBodies: boolean;
|
||||
function ApplyChangesAndJumpToFirstNewProc(CleanPos: integer;
|
||||
OldTopLine: integer;
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
||||
function NodeExtIsVariable(ANodeExt: TCodeTreeNodeExtension): boolean;
|
||||
function NodeExtHasVisibilty(ANodeExt: TCodeTreeNodeExtension;
|
||||
Visibility: TPascalClassSection): boolean;
|
||||
@ -157,7 +160,7 @@ type
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
procedure AdjustCursor(OldCodePos: TCodePosition; OldTopLine: integer;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer);
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer);
|
||||
function AddVariable(CursorNode: TCodeTreeNode;
|
||||
CleanCursorPos,OldTopLine: integer;
|
||||
const VariableName, NewType: string;
|
||||
@ -187,8 +190,10 @@ type
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
function AddMethods(CursorPos: TCodeXYPosition;// position in class declaration
|
||||
OldTopLine: integer;
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
const VirtualToOverride: boolean;
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
function AddPublishedVariable(const UpperClassName,VarName, VarType: string;
|
||||
SourceChangeCache: TSourceChangeCache): boolean; override;
|
||||
@ -314,7 +319,7 @@ begin
|
||||
FCompletingStartNode:=FCompletingStartNode.NextBrother;
|
||||
if FCompletingStartNode<>nil then
|
||||
FCompletingStartNode:=FCompletingStartNode.FirstChild;
|
||||
JumpToProcName:='';
|
||||
FJumpToProcName:='';
|
||||
end;
|
||||
|
||||
procedure TCodeCompletionCodeTool.SetCodeCompleteSrcChgCache(
|
||||
@ -826,7 +831,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCodeCompletionCodeTool.AdjustCursor(OldCodePos: TCodePosition;
|
||||
OldTopLine: integer; var NewPos: TCodeXYPosition; var NewTopLine: integer);
|
||||
OldTopLine: integer; out NewPos: TCodeXYPosition; out NewTopLine: integer);
|
||||
begin
|
||||
OldCodePos.Code.AdjustPosition(OldCodePos.P);
|
||||
NewPos.Code:=OldCodePos.Code;
|
||||
@ -4648,13 +4653,13 @@ var
|
||||
ProcCode,Indent,ANodeExt.ExtTxt3='');
|
||||
ASourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
|
||||
ProcCode);
|
||||
if JumpToProcName='' then begin
|
||||
if FJumpToProcName='' then begin
|
||||
// remember one proc body to jump to after the completion
|
||||
JumpToProcName:=ANodeExt.Txt;
|
||||
if System.Pos('.',JumpToProcName)<1 then
|
||||
JumpToProcName:=UpperCaseStr(TheClassName)+'.'+JumpToProcName;
|
||||
FJumpToProcName:=ANodeExt.Txt;
|
||||
if System.Pos('.',FJumpToProcName)<1 then
|
||||
FJumpToProcName:=UpperCaseStr(TheClassName)+'.'+FJumpToProcName;
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('CreateMissingProcBodies JumpToProcName="',JumpToProcName,'"');
|
||||
DebugLn('CreateMissingProcBodies FJumpToProcName="',FJumpToProcName,'"');
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
@ -5019,6 +5024,73 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc(
|
||||
CleanPos: integer; OldTopLine: integer;
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
||||
var
|
||||
OldCodeXYPos: TCodeXYPosition;
|
||||
OldCodePos: TCodePosition;
|
||||
CursorNode: TCodeTreeNode;
|
||||
CurClassName: String;
|
||||
ANode: TCodeTreeNode;
|
||||
ProcNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
|
||||
CurClassName:=ExtractClassName(FCodeCompleteClassNode,false);
|
||||
|
||||
// apply the changes and jump to first new proc body
|
||||
if not CleanPosToCodePos(CleanPos,OldCodePos) then
|
||||
RaiseException('TCodeCompletionCodeTool.CompleteCode Internal Error CleanPosToCodePos');
|
||||
if not CleanPosToCaret(CleanPos,OldCodeXYPos) then
|
||||
RaiseException('TCodeCompletionCodeTool.CompleteCode Internal Error CleanPosToCaret');
|
||||
if not ASourceChangeCache.Apply then
|
||||
RaiseException(ctsUnableToApplyChanges);
|
||||
|
||||
if FJumpToProcName<>'' then begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Jump to new proc body ... "',FJumpToProcName,'"');
|
||||
{$ENDIF}
|
||||
// there was a new proc body
|
||||
// -> find it and jump to
|
||||
|
||||
// reparse code
|
||||
BuildTreeAndGetCleanPos(trAll,OldCodeXYPos,CleanPos,[]);
|
||||
// find CodeTreeNode at cursor
|
||||
CursorNode:=FindDeepestNodeAtPos(CleanPos,true);
|
||||
// due to insertions in front of the class, the cursor position could
|
||||
// have changed
|
||||
while (CursorNode<>nil) do begin
|
||||
if (CursorNode.Desc=ctnTypeSection)
|
||||
or ((CursorNode.Parent<>nil) and (CursorNode.Parent.Desc=ctnTypeSection))
|
||||
then break;
|
||||
CursorNode:=CursorNode.Parent;
|
||||
end;
|
||||
FCodeCompleteClassNode:=FindClassNode(CursorNode,CurClassName,true,false);
|
||||
if FCodeCompleteClassNode=nil then
|
||||
RaiseException('oops, I lost your class');
|
||||
ANode:=FCodeCompleteClassNode.GetNodeOfTypes(
|
||||
[ctnTypeDefinition,ctnGenericType]);
|
||||
if ANode=nil then
|
||||
RaiseException(ctsClassNodeWithoutParentNode);
|
||||
if (ANode.Parent<>nil) and (ANode.Parent.Desc=ctnTypeSection) then
|
||||
ANode:=ANode.Parent;
|
||||
ProcNode:=FindProcNode(ANode,FJumpToProcName,
|
||||
[phpInUpperCase,phpIgnoreForwards]);
|
||||
if ProcNode=nil then
|
||||
RaiseException(ctsNewProcBodyNotFound);
|
||||
Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine);
|
||||
end else begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeCompletionCodeTool.ApplyChangesAndJumpToFirstNewProc Adjust Cursor ... ');
|
||||
{$ENDIF}
|
||||
// there was no new proc body
|
||||
// -> adjust cursor
|
||||
AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
|
||||
Result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeCompletionCodeTool.CompleteCode(CursorPos: TCodeXYPosition;
|
||||
OldTopLine: integer; out NewPos: TCodeXYPosition; out NewTopLine: integer;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
@ -5028,9 +5100,6 @@ var CleanCursorPos, Indent, insertPos: integer;
|
||||
OldCleanCursorPos: LongInt;
|
||||
|
||||
procedure CompleteClass;
|
||||
var
|
||||
OldCodePos: TCodePosition;
|
||||
CurClassName: String;
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeCompletionCodeTool.CompleteCode In-a-class ',NodeDescriptionAsString(AClassNode.Desc));
|
||||
@ -5042,7 +5111,6 @@ var CleanCursorPos, Indent, insertPos: integer;
|
||||
DebugLn('TCodeCompletionCodeTool.CompleteCode C ',dbgs(CleanCursorPos),', |',copy(Src,CleanCursorPos,8));
|
||||
{$ENDIF}
|
||||
CodeCompleteClassNode:=AClassNode;
|
||||
CurClassName:=ExtractClassName(AClassNode,false);
|
||||
try
|
||||
// go through all properties and procs
|
||||
// insert read + write prop specifiers
|
||||
@ -5082,55 +5150,8 @@ var CleanCursorPos, Indent, insertPos: integer;
|
||||
DebugLn('TCodeCompletionCodeTool.CompleteCode Apply ... ');
|
||||
{$ENDIF}
|
||||
// apply the changes and jump to first new proc body
|
||||
if not CleanPosToCodePos(CleanCursorPos,OldCodePos) then
|
||||
RaiseException('TCodeCompletionCodeTool.CompleteCode Internal Error CleanPosToCodePos');
|
||||
if not SourceChangeCache.Apply then
|
||||
RaiseException(ctsUnableToApplyChanges);
|
||||
|
||||
if JumpToProcName<>'' then begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeCompletionCodeTool.CompleteCode Jump to new proc body ... "',JumpToProcName,'"');
|
||||
{$ENDIF}
|
||||
// there was a new proc body
|
||||
// -> find it and jump to
|
||||
|
||||
// reparse code
|
||||
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
||||
// find CodeTreeNode at cursor
|
||||
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
||||
// due to insertions in front of the class, the cursor position could
|
||||
// have changed
|
||||
while (CursorNode<>nil) do begin
|
||||
if (CursorNode.Desc=ctnTypeSection)
|
||||
or ((CursorNode.Parent<>nil) and (CursorNode.Parent.Desc=ctnTypeSection))
|
||||
then break;
|
||||
CursorNode:=CursorNode.Parent;
|
||||
end;
|
||||
FCodeCompleteClassNode:=
|
||||
FindClassNode(CursorNode,CurClassName,true,false);
|
||||
if FCodeCompleteClassNode=nil then
|
||||
RaiseException('oops, I lost your class');
|
||||
ANode:=FCodeCompleteClassNode.GetNodeOfTypes(
|
||||
[ctnTypeDefinition,ctnGenericType]);
|
||||
if ANode=nil then
|
||||
RaiseException(ctsClassNodeWithoutParentNode);
|
||||
if (ANode.Parent<>nil) and (ANode.Parent.Desc=ctnTypeSection) then
|
||||
ANode:=ANode.Parent;
|
||||
ProcNode:=FindProcNode(ANode,JumpToProcName,
|
||||
[phpInUpperCase,phpIgnoreForwards]);
|
||||
if ProcNode=nil then
|
||||
RaiseException(ctsNewProcBodyNotFound);
|
||||
Result:=FindJumpPointInProcNode(ProcNode,NewPos,NewTopLine);
|
||||
end else begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeCompletionCodeTool.CompleteCode Adjust Cursor ... ');
|
||||
{$ENDIF}
|
||||
// there was no new proc body
|
||||
// -> adjust cursor
|
||||
AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
Result:=ApplyChangesAndJumpToFirstNewProc(CleanCursorPos,OldTopLine,
|
||||
NewPos,NewTopLine);
|
||||
finally
|
||||
FreeClassInsertionList;
|
||||
end;
|
||||
@ -5629,8 +5650,10 @@ begin
|
||||
end;
|
||||
|
||||
function TCodeCompletionCodeTool.AddMethods(CursorPos: TCodeXYPosition;
|
||||
OldTopLine: integer;
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
const VirtualToOverride: boolean;
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
var
|
||||
CleanCursorPos: integer;
|
||||
@ -5651,6 +5674,7 @@ var
|
||||
NewClassPart: TNewClassPart;
|
||||
Beautifier: TBeautifyCodeOptions;
|
||||
ProcCode: String;
|
||||
CurClassName: String;
|
||||
begin
|
||||
Result:=false;
|
||||
if (ListOfPCodeXYPosition=nil) or (ListOfPCodeXYPosition.Count=0) then
|
||||
@ -5659,6 +5683,7 @@ begin
|
||||
if (SourceChangeCache=nil) then
|
||||
RaiseException('need a SourceChangeCache');
|
||||
|
||||
CodeCompleteSrcChgCache:=SourceChangeCache;
|
||||
Beautifier:=SourceChangeCache.BeautifyCodeOptions;
|
||||
NewMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
||||
try
|
||||
@ -5676,10 +5701,10 @@ begin
|
||||
// parse unit
|
||||
NewCodeTool.BuildTreeAndGetCleanPos(trAll,CodeXYPos,CleanCursorPos,[]);
|
||||
// find node at position
|
||||
ProcNode:=FindDeepestExpandedNodeAtPos(CleanCursorPos,true);
|
||||
ProcNode:=NewCodeTool.FindDeepestExpandedNodeAtPos(CleanCursorPos,true);
|
||||
if (ProcNode.Desc<>ctnProcedure)
|
||||
or (ProcNode.Parent=nil) then begin
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
NewCodeTool.MoveCursorToNodeStart(ProcNode);
|
||||
RaiseException('TCodeCompletionCodeTool.AddMethods source position not a procedure');
|
||||
end;
|
||||
// find visibility
|
||||
@ -5699,7 +5724,7 @@ begin
|
||||
if VirtualStartPos>=1 then begin
|
||||
// replace virtual with override
|
||||
FullProcCode:=copy(FullProcCode,1,VirtualStartPos-1)
|
||||
+'override'
|
||||
+'override;'
|
||||
+copy(FullProcCode,VirtualEndPos,length(FullProcCode));
|
||||
end;
|
||||
// remove abstract
|
||||
@ -5707,14 +5732,13 @@ begin
|
||||
NewCodeTool.Scanner.NestedComments);
|
||||
end;
|
||||
|
||||
ProcCode:=ExtractProcHead(ProcNode,[phpWithStart,
|
||||
phpAddClassname,phpWithVarModifiers,phpWithParameterNames,
|
||||
phpWithResultType,phpWithCallingSpecs]);
|
||||
ProcCode:=NewCodeTool.ExtractProcHead(ProcNode,[phpWithStart,
|
||||
phpWithoutClassName,phpWithVarModifiers,phpWithParameterNames,
|
||||
phpWithResultType,phpWithCallingSpecs]);
|
||||
ProcCode:=ProcCode+Beautifier.LineEnd
|
||||
+'begin'+Beautifier.LineEnd
|
||||
+GetIndentStr(Beautifier.Indent)+Beautifier.LineEnd
|
||||
+'end;';
|
||||
ProcCode:=Beautifier.BeautifyProc(ProcCode,0,false);
|
||||
|
||||
// add method data
|
||||
NodeExt:=NodeExtMemManager.NewNode;
|
||||
@ -5727,16 +5751,18 @@ begin
|
||||
DebugLn(['TCodeCompletionCodeTool.AddMethods ',i,' CleanProcTxt=',CleanProcCode,' FullProcTxt=',FullProcCode]);
|
||||
end;
|
||||
|
||||
BuildTreeAndGetCleanPos(trAll,CursorPos, CleanCursorPos,[]);
|
||||
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
||||
|
||||
// find node at position
|
||||
CursorNode:=FindDeepestExpandedNodeAtPos(CleanCursorPos,true);
|
||||
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
||||
|
||||
// if cursor is on type node, find class node
|
||||
if CursorNode.Desc=ctnTypeDefinition then
|
||||
CursorNode:=CursorNode.FirstChild
|
||||
else if CursorNode.Desc=ctnGenericType then
|
||||
CursorNode:=CursorNode.LastChild;
|
||||
CursorNode:=CursorNode.LastChild
|
||||
else
|
||||
CursorNode:=CursorNode.GetNodeOfTypes([ctnClass,ctnClassInterface]);
|
||||
if (CursorNode=nil) or (CursorNode.Desc<>ctnClass) then begin
|
||||
DebugLn(['TIdentCompletionTool.AddMethods cursor not in a class']);
|
||||
exit;
|
||||
@ -5744,6 +5770,7 @@ begin
|
||||
|
||||
CodeCompleteSrcChgCache:=SourceChangeCache;
|
||||
CodeCompleteClassNode:=CursorNode;
|
||||
CurClassName:=ExtractClassName(CursorNode,false);
|
||||
|
||||
// add methods
|
||||
AVLNode:=NewMethods.FindLowest;
|
||||
@ -5762,6 +5789,8 @@ begin
|
||||
else NewClassPart:=ncpPublicProcs;
|
||||
end;
|
||||
|
||||
// change classname
|
||||
ProcCode:=Beautifier.AddClassAndNameToProc(ProcCode,CurClassName,ProcName);
|
||||
AddClassInsertion(CleanProcCode,FullProcCode,ProcName,NewClassPart,nil,
|
||||
ProcCode);
|
||||
|
||||
@ -5775,11 +5804,12 @@ begin
|
||||
if not CreateMissingProcBodies then exit;
|
||||
|
||||
// apply changes
|
||||
if not SourceChangeCache.Apply then
|
||||
RaiseException(ctsUnableToApplyChanges);
|
||||
|
||||
if not ApplyChangesAndJumpToFirstNewProc(CleanCursorPos,OldTopLine,
|
||||
NewPos,NewTopLine) then exit;
|
||||
|
||||
Result:=true;
|
||||
finally
|
||||
FreeClassInsertionList;
|
||||
NodeExtMemManager.DisposeAVLTree(NewMethods);
|
||||
end;
|
||||
end;
|
||||
|
@ -442,9 +442,11 @@ type
|
||||
function CompleteCode(Code: TCodeBuffer; X,Y,TopLine: integer;
|
||||
out NewCode: TCodeBuffer;
|
||||
out NewX, NewY, NewTopLine: integer): boolean;
|
||||
function AddMethods(Code: TCodeBuffer; X,Y: integer;
|
||||
function AddMethods(Code: TCodeBuffer; X,Y, TopLine: integer;
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
const VirtualToOverride: boolean): boolean;
|
||||
const VirtualToOverride: boolean;
|
||||
out NewCode: TCodeBuffer;
|
||||
out NewX, NewY, NewTopLine: integer): boolean;
|
||||
function FindRedefinitions(Code: TCodeBuffer;
|
||||
out TreeOfCodeTreeNodeExt: TAVLTree; WithEnums: boolean): boolean;
|
||||
function RemoveRedefinitions(Code: TCodeBuffer;
|
||||
@ -3002,11 +3004,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.AddMethods(Code: TCodeBuffer; X, Y: integer;
|
||||
ListOfPCodeXYPosition: TFPList; const VirtualToOverride: boolean
|
||||
): boolean;
|
||||
function TCodeToolManager.AddMethods(Code: TCodeBuffer; X, Y, TopLine: integer;
|
||||
ListOfPCodeXYPosition: TFPList; const VirtualToOverride: boolean;
|
||||
out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer): boolean;
|
||||
var
|
||||
CursorPos: TCodeXYPosition;
|
||||
CursorPos, NewPos: TCodeXYPosition;
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeToolManager.AddMethods A ',Code.Filename);
|
||||
@ -3017,8 +3019,11 @@ begin
|
||||
CursorPos.Y:=Y;
|
||||
CursorPos.Code:=Code;
|
||||
try
|
||||
Result:=FCurCodeTool.AddMethods(CursorPos,ListOfPCodeXYPosition,
|
||||
VirtualToOverride,SourceChangeCache);
|
||||
Result:=FCurCodeTool.AddMethods(CursorPos,TopLine,ListOfPCodeXYPosition,
|
||||
VirtualToOverride,NewPos,NewTopLine,SourceChangeCache);
|
||||
NewCode:=NewPos.Code;
|
||||
NewX:=NewPos.X;
|
||||
NewY:=NewPos.Y;
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
|
@ -1052,7 +1052,7 @@ end;
|
||||
|
||||
procedure TCTDirectoryCachePool.IncreaseTimeStamp;
|
||||
begin
|
||||
DebugLn(['TCTDirectoryCachePool.IncreaseTimeStamp ']);
|
||||
//DebugLn(['TCTDirectoryCachePool.IncreaseTimeStamp ']);
|
||||
if FTimeStamp<>High(FTimeStamp) then
|
||||
inc(FTimeStamp)
|
||||
else
|
||||
|
@ -42,6 +42,8 @@ var
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
i: Integer;
|
||||
CodeXYPos: TCodeXYPosition;
|
||||
NewCode: TCodeBuffer;
|
||||
NewX, NewY, NewTopLine: integer;
|
||||
begin
|
||||
if (ParamCount>=1) and (Paramcount<>3) then begin
|
||||
writeln('Usage:');
|
||||
@ -59,7 +61,6 @@ begin
|
||||
Filename:=GetCurrentDir+'/scanexamples/abstractclass1.pas';
|
||||
X:=3;
|
||||
Y:=18;
|
||||
|
||||
if (ParamCount>=3) then begin
|
||||
Filename:=ExpandFileName(ParamStr(1));
|
||||
X:=StrToInt(ParamStr(2));
|
||||
@ -85,9 +86,10 @@ begin
|
||||
writeln('FindAbstractMethods failed: ',CodeToolBoss.ErrorMessage);
|
||||
end;
|
||||
|
||||
if CodeToolBoss.AddMethods(Code,X,Y,ListOfPCodeXYPosition,true)
|
||||
if CodeToolBoss.AddMethods(Code,X,Y,1,ListOfPCodeXYPosition,true,
|
||||
NewCode,NewX,NewY,NewTopLine)
|
||||
then begin
|
||||
writeln('AddMethods succeeded: ');
|
||||
writeln('AddMethods succeeded: ',NewCode.Filename,' (',NewY,',',NewX,') ');
|
||||
writeln(Code.Source);
|
||||
end else begin
|
||||
writeln('AddMethods failed: ',CodeToolBoss.ErrorMessage);
|
||||
|
@ -8,7 +8,7 @@ uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TAbstractClass = class
|
||||
TAbstractClass = class(TStrings)
|
||||
public
|
||||
procedure Increase; virtual; abstract;
|
||||
procedure Decrease; virtual; abstract;
|
||||
|
@ -759,7 +759,7 @@ type
|
||||
IgnoreJumpCentered: boolean): boolean;
|
||||
function JumpToCleanPos(NewCleanPos, NewTopLineCleanPos,
|
||||
NewBottomLineCleanPos: integer;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer;
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer;
|
||||
IgnoreJumpCentered: boolean): boolean;
|
||||
function NodeIsForwardDeclaration(Node: TCodeTreeNode): boolean;
|
||||
|
||||
@ -3918,8 +3918,8 @@ begin
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.JumpToCleanPos(NewCleanPos, NewTopLineCleanPos,
|
||||
NewBottomLineCleanPos: integer; var NewPos: TCodeXYPosition;
|
||||
var NewTopLine: integer; IgnoreJumpCentered: boolean): boolean;
|
||||
NewBottomLineCleanPos: integer; out NewPos: TCodeXYPosition;
|
||||
out NewTopLine: integer; IgnoreJumpCentered: boolean): boolean;
|
||||
var
|
||||
CenteredTopLine: integer;
|
||||
NewTopLinePos: TCodeXYPosition;
|
||||
|
@ -1461,7 +1461,8 @@ begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TIdentCompletionTool.GatherIdentifiers G');
|
||||
{$ENDIF}
|
||||
GatherUsefulIdentifiers(IdentStartPos,GatherContext,BeautifyCodeOptions);
|
||||
GatherUsefulIdentifiers(IdentStartPos,CreateFindContext(Self,CursorNode),
|
||||
BeautifyCodeOptions);
|
||||
|
||||
// check for incomplete context
|
||||
|
||||
@ -1682,16 +1683,18 @@ begin
|
||||
|
||||
// find node at position
|
||||
CursorNode:=FindDeepestExpandedNodeAtPos(CleanCursorPos,true);
|
||||
|
||||
|
||||
// if cursor is on type node, find class node
|
||||
if CursorNode.Desc=ctnTypeDefinition then
|
||||
CursorNode:=CursorNode.FirstChild
|
||||
else if CursorNode.Desc=ctnGenericType then
|
||||
CursorNode:=CursorNode.LastChild;
|
||||
CursorNode:=CursorNode.LastChild
|
||||
else
|
||||
CursorNode:=CursorNode.GetNodeOfTypes([ctnClass,ctnClassInterface]);
|
||||
if (CursorNode=nil) or (CursorNode.Desc<>ctnClass)
|
||||
or ((CursorNode.SubDesc and ctnsForwardDeclaration)>0) then begin
|
||||
DebugLn(['TIdentCompletionTool.FindAbstractMethods cursor not in a class']);
|
||||
exit;
|
||||
MoveCursorToNodeStart(CursorNode);
|
||||
RaiseException('TIdentCompletionTool.FindAbstractMethods cursor is not in a class');
|
||||
end;
|
||||
ClassNode:=CursorNode;
|
||||
|
||||
|
@ -63,7 +63,7 @@ type
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer;
|
||||
var RevertableJump: boolean): boolean;
|
||||
function FindJumpPointInProcNode(ProcNode: TCodeTreeNode;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
||||
function GatherProcNodes(StartNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes; const UpperClassName: string): TAVLTree;
|
||||
function FindFirstDifferenceNode(SearchForNodes, SearchInNodes: TAVLTree;
|
||||
@ -678,7 +678,7 @@ begin
|
||||
end;
|
||||
|
||||
function TMethodJumpingCodeTool.FindJumpPointInProcNode(ProcNode: TCodeTreeNode;
|
||||
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
||||
out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
|
||||
var DestNode: TCodeTreeNode;
|
||||
i, NewCleanPos: integer;
|
||||
begin
|
||||
|
129
ide/abstractsmethodsdlg.lfm
Normal file
129
ide/abstractsmethodsdlg.lfm
Normal file
@ -0,0 +1,129 @@
|
||||
object AbstractMethodsDialog: TAbstractMethodsDialog
|
||||
Left = 350
|
||||
Height = 344
|
||||
Top = 291
|
||||
Width = 581
|
||||
HorzScrollBar.Page = 580
|
||||
VertScrollBar.Page = 343
|
||||
ActiveControl = MethodsCheckListBox
|
||||
Caption = 'AbstractMethodsDialog'
|
||||
ClientHeight = 344
|
||||
ClientWidth = 581
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
object NoteLabel: TLabel
|
||||
Height = 20
|
||||
Width = 581
|
||||
Align = alTop
|
||||
Caption = 'NoteLabel'
|
||||
ParentColor = False
|
||||
WordWrap = True
|
||||
end
|
||||
object MethodsGroupBox: TGroupBox
|
||||
Height = 274
|
||||
Top = 20
|
||||
Width = 581
|
||||
Align = alClient
|
||||
Caption = 'MethodsGroupBox'
|
||||
ClientHeight = 255
|
||||
ClientWidth = 577
|
||||
TabOrder = 0
|
||||
object MethodsCheckListBox: TCheckListBox
|
||||
AnchorSideBottom.Control = SelectAllButton
|
||||
Height = 214
|
||||
Width = 577
|
||||
Align = alTop
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
OnClickCheck = MethodsCheckListBoxClickCheck
|
||||
TabOrder = 0
|
||||
TopIndex = -1
|
||||
end
|
||||
object SelectAllButton: TButton
|
||||
AnchorSideLeft.Control = MethodsGroupBox
|
||||
AnchorSideBottom.Control = MethodsGroupBox
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 29
|
||||
Top = 220
|
||||
Width = 110
|
||||
Anchors = [akLeft, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'SelectAllButton'
|
||||
OnClick = SelectAllButtonClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object SelectNoneButton: TButton
|
||||
AnchorSideLeft.Control = SelectAllButton
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideBottom.Control = MethodsGroupBox
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 122
|
||||
Height = 29
|
||||
Top = 220
|
||||
Width = 129
|
||||
Anchors = [akLeft, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'SelectNoneButton'
|
||||
OnClick = SelectNoneButtonClick
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
object BtnPanel: TPanel
|
||||
Height = 50
|
||||
Top = 294
|
||||
Width = 581
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 50
|
||||
ClientWidth = 581
|
||||
TabOrder = 1
|
||||
object CancelBitBtn: TBitBtn
|
||||
Left = 497
|
||||
Height = 38
|
||||
Top = 6
|
||||
Width = 78
|
||||
Align = alRight
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Cancel = True
|
||||
Caption = 'Cancel'
|
||||
Kind = bkCancel
|
||||
ModalResult = 2
|
||||
NumGlyphs = 0
|
||||
TabOrder = 0
|
||||
end
|
||||
object AddFirstBitBtn: TBitBtn
|
||||
Left = 339
|
||||
Height = 38
|
||||
Top = 6
|
||||
Width = 59
|
||||
Align = alRight
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = '&Yes'
|
||||
Default = True
|
||||
Kind = bkYes
|
||||
ModalResult = 6
|
||||
NumGlyphs = 0
|
||||
OnClick = AddFirstBitBtnClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object AddAllBitBtn: TBitBtn
|
||||
Left = 404
|
||||
Height = 38
|
||||
Top = 6
|
||||
Width = 87
|
||||
Align = alRight
|
||||
AutoSize = True
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Yes to &All'
|
||||
Kind = bkYesToAll
|
||||
ModalResult = 10
|
||||
NumGlyphs = 0
|
||||
OnClick = AddAllBitBtnClick
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
end
|
43
ide/abstractsmethodsdlg.lrs
Normal file
43
ide/abstractsmethodsdlg.lrs
Normal file
@ -0,0 +1,43 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TAbstractMethodsDialog','FORMDATA',[
|
||||
'TPF0'#22'TAbstractMethodsDialog'#21'AbstractMethodsDialog'#4'Left'#3'^'#1#6
|
||||
+'Height'#3'X'#1#3'Top'#3'#'#1#5'Width'#3'E'#2#18'HorzScrollBar.Page'#3'D'#2
|
||||
+#18'VertScrollBar.Page'#3'W'#1#13'ActiveControl'#7#19'MethodsCheckListBox'#7
|
||||
+'Caption'#6#21'AbstractMethodsDialog'#12'ClientHeight'#3'X'#1#11'ClientWidth'
|
||||
+#3'E'#2#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#0#6'TLab'
|
||||
+'el'#9'NoteLabel'#6'Height'#2#20#5'Width'#3'E'#2#5'Align'#7#5'alTop'#7'Capti'
|
||||
+'on'#6#9'NoteLabel'#11'ParentColor'#8#8'WordWrap'#9#0#0#9'TGroupBox'#15'Meth'
|
||||
+'odsGroupBox'#6'Height'#3#18#1#3'Top'#2#20#5'Width'#3'E'#2#5'Align'#7#8'alCl'
|
||||
+'ient'#7'Caption'#6#15'MethodsGroupBox'#12'ClientHeight'#3#255#0#11'ClientWi'
|
||||
+'dth'#3'A'#2#8'TabOrder'#2#0#0#13'TCheckListBox'#19'MethodsCheckListBox'#24
|
||||
+'AnchorSideBottom.Control'#7#15'SelectAllButton'#6'Height'#3#214#0#5'Width'#3
|
||||
+'A'#2#5'Align'#7#5'alTop'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBo'
|
||||
+'ttom'#0#12'OnClickCheck'#7#29'MethodsCheckListBoxClickCheck'#8'TabOrder'#2#0
|
||||
+#8'TopIndex'#2#255#0#0#7'TButton'#15'SelectAllButton'#22'AnchorSideLeft.Cont'
|
||||
+'rol'#7#15'MethodsGroupBox'#24'AnchorSideBottom.Control'#7#15'MethodsGroupBo'
|
||||
+'x'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#2#6#6'Height'#2#29#3'To'
|
||||
+'p'#3#220#0#5'Width'#2'n'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#8'AutoSize'#9
|
||||
+#20'BorderSpacing.Around'#2#6#7'Caption'#6#15'SelectAllButton'#7'OnClick'#7
|
||||
+#20'SelectAllButtonClick'#8'TabOrder'#2#1#0#0#7'TButton'#16'SelectNoneButton'
|
||||
+#22'AnchorSideLeft.Control'#7#15'SelectAllButton'#19'AnchorSideLeft.Side'#7#9
|
||||
+'asrBottom'#24'AnchorSideBottom.Control'#7#15'MethodsGroupBox'#21'AnchorSide'
|
||||
+'Bottom.Side'#7#9'asrBottom'#4'Left'#2'z'#6'Height'#2#29#3'Top'#3#220#0#5'Wi'
|
||||
+'dth'#3#129#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0#8'AutoSize'#9#20'BorderS'
|
||||
+'pacing.Around'#2#6#7'Caption'#6#16'SelectNoneButton'#7'OnClick'#7#21'Select'
|
||||
+'NoneButtonClick'#8'TabOrder'#2#2#0#0#0#6'TPanel'#8'BtnPanel'#6'Height'#2'2'
|
||||
+#3'Top'#3'&'#1#5'Width'#3'E'#2#5'Align'#7#8'alBottom'#10'BevelOuter'#7#6'bvN'
|
||||
+'one'#12'ClientHeight'#2'2'#11'ClientWidth'#3'E'#2#8'TabOrder'#2#1#0#7'TBitB'
|
||||
+'tn'#12'CancelBitBtn'#4'Left'#3#241#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'#4'Kind'#7#8'bkCancel'#11'ModalResult'#2#2#9'NumGlyph'
|
||||
+'s'#2#0#8'TabOrder'#2#0#0#0#7'TBitBtn'#14'AddFirstBitBtn'#4'Left'#3'S'#1#6'H'
|
||||
+'eight'#2'&'#3'Top'#2#6#5'Width'#2';'#5'Align'#7#7'alRight'#8'AutoSize'#9#20
|
||||
+'BorderSpacing.Around'#2#6#7'Caption'#6#4'&Yes'#7'Default'#9#4'Kind'#7#5'bkY'
|
||||
+'es'#11'ModalResult'#2#6#9'NumGlyphs'#2#0#7'OnClick'#7#19'AddFirstBitBtnClic'
|
||||
+'k'#8'TabOrder'#2#1#0#0#7'TBitBtn'#12'AddAllBitBtn'#4'Left'#3#148#1#6'Height'
|
||||
+#2'&'#3'Top'#2#6#5'Width'#2'W'#5'Align'#7#7'alRight'#8'AutoSize'#9#20'Border'
|
||||
+'Spacing.Around'#2#6#7'Caption'#6#11'Yes to &All'#4'Kind'#7#10'bkYesToAll'#11
|
||||
+'ModalResult'#2#10#9'NumGlyphs'#2#0#7'OnClick'#7#17'AddAllBitBtnClick'#8'Tab'
|
||||
+'Order'#2#2#0#0#0#0
|
||||
]);
|
397
ide/abstractsmethodsdlg.pas
Normal file
397
ide/abstractsmethodsdlg.pas
Normal file
@ -0,0 +1,397 @@
|
||||
{
|
||||
***************************************************************************
|
||||
* *
|
||||
* 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:
|
||||
A dialog showing the abstract methods of the current class
|
||||
(at cursor in source editor).
|
||||
With the ability to implement them automatically by adding empty method
|
||||
stubs.
|
||||
}
|
||||
unit AbstractsMethodsDlg;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
CheckLst, StdCtrls, ExtCtrls, Buttons,
|
||||
CodeAtom, CodeTree, PascalParserTool, CodeCache, CodeToolManager,
|
||||
LazIDEIntf, SrcEditorIntf;
|
||||
|
||||
type
|
||||
|
||||
{ TAbstractMethodDlgItem }
|
||||
|
||||
TAbstractMethodDlgItem = class
|
||||
public
|
||||
CodeXYPos: TCodeXYPosition;
|
||||
ProcHead: string;
|
||||
BelongsToStartClass: boolean;
|
||||
end;
|
||||
|
||||
{ TAbstractMethodsDialog }
|
||||
|
||||
TAbstractMethodsDialog = class(TForm)
|
||||
AddAllBitBtn: TBitBtn;
|
||||
NoteLabel: TLabel;
|
||||
SelectNoneButton: TButton;
|
||||
SelectAllButton: TButton;
|
||||
CancelBitBtn: TBitBtn;
|
||||
AddFirstBitBtn: TBitBtn;
|
||||
MethodsCheckListBox: TCheckListBox;
|
||||
MethodsGroupBox: TGroupBox;
|
||||
BtnPanel: TPanel;
|
||||
procedure AddAllBitBtnClick(Sender: TObject);
|
||||
procedure AddFirstBitBtnClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure MethodsCheckListBoxClickCheck(Sender: TObject);
|
||||
procedure SelectAllButtonClick(Sender: TObject);
|
||||
procedure SelectNoneButtonClick(Sender: TObject);
|
||||
private
|
||||
CodePos: TCodeXYPosition;
|
||||
TopLine: integer;
|
||||
FItems: TFPList;// list of TAbstractMethodDlgItem
|
||||
FCheckingSelection: boolean;
|
||||
procedure ClearItems;
|
||||
procedure UpdateButtons;
|
||||
function CheckSelection: boolean;
|
||||
function AddOverrides(OnlyFirst: boolean): boolean;
|
||||
public
|
||||
NewCode: TCodeBuffer;
|
||||
NewX,NewY,NewTopLine: integer;
|
||||
procedure Init(aListOfPCodeXYPosition: TFPList; aCode: TCodeBuffer;
|
||||
const aCaret: TPoint; aTopLine: integer);
|
||||
end;
|
||||
|
||||
function ShowAbstractMethodsDialog: TModalResult;
|
||||
|
||||
implementation
|
||||
|
||||
function ShowAbstractMethodsDialog: TModalResult;
|
||||
var
|
||||
AbstractMethodsDialog: TAbstractMethodsDialog;
|
||||
SrcEdit: TSourceEditorInterface;
|
||||
Code: TCodeBuffer;
|
||||
Caret: TPoint;
|
||||
ErrMsg: String;
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
ListOfPCodeXYPosition:=nil;
|
||||
try
|
||||
// init codetools
|
||||
ErrMsg:='IDE is busy';
|
||||
if not LazarusIDE.BeginCodeTools then exit;
|
||||
|
||||
// get cursor position
|
||||
ErrMsg:='Cursor is not in a class declaration';
|
||||
SrcEdit:=SourceEditorWindow.ActiveEditor;
|
||||
if SrcEdit=nil then exit;
|
||||
Code:=TCodeBuffer(SrcEdit.CodeToolsBuffer);
|
||||
if Code=nil then exit;
|
||||
Caret:=SrcEdit.CursorTextXY;
|
||||
|
||||
// check cursor is in a class
|
||||
if not CodeToolBoss.FindAbstractMethods(Code,Caret.X,Caret.Y,
|
||||
ListOfPCodeXYPosition,false) then
|
||||
begin
|
||||
if CodeToolBoss.ErrorMessage<>'' then begin
|
||||
ErrMsg:='';
|
||||
LazarusIDE.DoJumpToCodeToolBossError;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if there are abstract methods left to override
|
||||
if (ListOfPCodeXYPosition=nil) or (ListOfPCodeXYPosition.Count=0) then begin
|
||||
ErrMsg:='';
|
||||
MessageDlg('No abstract methods found',
|
||||
'There are no abstract methods left to override.'
|
||||
,mtConfirmation,[mbOk],0);
|
||||
Result:=mrOk;
|
||||
exit;
|
||||
end;
|
||||
|
||||
ErrMsg:='';
|
||||
AbstractMethodsDialog:=TAbstractMethodsDialog.Create(nil);
|
||||
AbstractMethodsDialog.Init(ListOfPCodeXYPosition,Code,Caret,SrcEdit.TopLine);
|
||||
Result:=AbstractMethodsDialog.ShowModal;
|
||||
AbstractMethodsDialog.Free;
|
||||
finally
|
||||
CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
|
||||
if ErrMsg<>'' then begin
|
||||
MessageDlg('Error','Unable to show abstract methods of the current class, because'#13
|
||||
+ErrMsg,mtError,[mbCancel],0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TAbstractMethodsDialog }
|
||||
|
||||
procedure TAbstractMethodsDialog.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FItems:=TFPList.Create;
|
||||
|
||||
AddFirstBitBtn.Caption:='Override first selected';
|
||||
AddAllBitBtn.Caption:='Override all selected';
|
||||
CancelBitBtn.Caption:='Cancel';
|
||||
|
||||
SelectNoneButton.Caption:='Select none';
|
||||
SelectAllButton.Caption:='Select all';
|
||||
MethodsGroupBox.Caption:='Abstract methods - not overriden';
|
||||
end;
|
||||
|
||||
procedure TAbstractMethodsDialog.AddFirstBitBtnClick(Sender: TObject);
|
||||
begin
|
||||
if not AddOverrides(true) then exit;
|
||||
ModalResult:=mrOk;
|
||||
end;
|
||||
|
||||
procedure TAbstractMethodsDialog.AddAllBitBtnClick(Sender: TObject);
|
||||
begin
|
||||
if not AddOverrides(false) then exit;
|
||||
ModalResult:=mrOk;
|
||||
end;
|
||||
|
||||
procedure TAbstractMethodsDialog.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
ClearItems;
|
||||
end;
|
||||
|
||||
procedure TAbstractMethodsDialog.MethodsCheckListBoxClickCheck(Sender: TObject);
|
||||
begin
|
||||
CheckSelection;
|
||||
UpdateButtons;
|
||||
end;
|
||||
|
||||
procedure TAbstractMethodsDialog.SelectAllButtonClick(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to FItems.Count-1 do
|
||||
MethodsCheckListBox.Checked[i]:=
|
||||
not TAbstractMethodDlgItem(FItems[i]).BelongsToStartClass;
|
||||
end;
|
||||
|
||||
procedure TAbstractMethodsDialog.SelectNoneButtonClick(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to FItems.Count-1 do
|
||||
MethodsCheckListBox.Checked[i]:=false;
|
||||
end;
|
||||
|
||||
procedure TAbstractMethodsDialog.ClearItems;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if FItems=nil then exit;
|
||||
for i:=0 to FItems.Count-1 do
|
||||
TObject(FItems[i]).Free;
|
||||
FreeAndNil(FItems);
|
||||
end;
|
||||
|
||||
procedure TAbstractMethodsDialog.UpdateButtons;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i:=MethodsCheckListBox.Items.Count-1;
|
||||
while (i>=0) and (not MethodsCheckListBox.Checked[i]) do dec(i);
|
||||
AddFirstBitBtn.Enabled:=i>=0;
|
||||
AddAllBitBtn.Enabled:=AddFirstBitBtn.Enabled;
|
||||
end;
|
||||
|
||||
function TAbstractMethodsDialog.CheckSelection: boolean;
|
||||
var
|
||||
i: Integer;
|
||||
Item: TAbstractMethodDlgItem;
|
||||
begin
|
||||
Result:=true;
|
||||
if FCheckingSelection then exit;
|
||||
FCheckingSelection:=true;
|
||||
try
|
||||
for i:=0 to FItems.Count-1 do begin
|
||||
Item:=TAbstractMethodDlgItem(FItems[i]);
|
||||
if MethodsCheckListBox.Checked[i] and Item.BelongsToStartClass then begin
|
||||
if Result then begin
|
||||
MessageDlg('Impossible',
|
||||
'This method can not be overriden because it is defined in the current class',
|
||||
mtError,[mbCancel],0);
|
||||
Result:=false;
|
||||
end;
|
||||
MethodsCheckListBox.Checked[i]:=false;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FCheckingSelection:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAbstractMethodsDialog.AddOverrides(OnlyFirst: boolean): boolean;
|
||||
var
|
||||
i: Integer;
|
||||
NewList: TFPList;
|
||||
Item: TAbstractMethodDlgItem;
|
||||
begin
|
||||
Result:=false;
|
||||
if not CheckSelection then exit;
|
||||
NewList:=nil;
|
||||
try
|
||||
for i:=0 to FItems.Count-1 do begin
|
||||
if not MethodsCheckListBox.Checked[i] then continue;
|
||||
Item:=TAbstractMethodDlgItem(FItems[i]);
|
||||
AddCodePosition(NewList,Item.CodeXYPos);
|
||||
DebugLn(['TAbstractMethodsDialog.AddOverrides ',Item.CodeXYPos.Code.Filename,' ',Item.CodeXYPos.X,',',Item.CodeXYPos.Y]);
|
||||
if OnlyFirst then break;
|
||||
end;
|
||||
|
||||
//DebugLn(['TAbstractMethodsDialog.AddOverrides ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
|
||||
if not CodeToolBoss.AddMethods(CodePos.Code,CodePos.X,CodePos.Y,TopLine,
|
||||
NewList,true,NewCode,NewX,NewY,NewTopLine)
|
||||
then begin
|
||||
LazarusIDE.DoJumpToCodeToolBossError;
|
||||
exit;
|
||||
end;
|
||||
|
||||
LazarusIDE.DoOpenFileAndJumpToPos(NewCode.Filename,Point(NewX,NewY),
|
||||
NewTopLine,-1,[]);
|
||||
finally
|
||||
CodeToolBoss.FreeListOfPCodeXYPosition(NewList);
|
||||
end;
|
||||
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TAbstractMethodsDialog.Init(aListOfPCodeXYPosition: TFPList;
|
||||
aCode: TCodeBuffer; const aCaret: TPoint; aTopLine: integer);
|
||||
var
|
||||
i: Integer;
|
||||
CodeXYPos: TCodeXYPosition;
|
||||
CurTool: TCodeTool;
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
Tool: TCodeTool;
|
||||
CleanPos: integer;
|
||||
ClassNode: TCodeTreeNode;
|
||||
CurNode: TCodeTreeNode;
|
||||
ProcNode: TCodeTreeNode;
|
||||
NewItem: TAbstractMethodDlgItem;
|
||||
StartClassName: String;
|
||||
BelongsToStartClassCnt: Integer;
|
||||
NoteStr: String;
|
||||
begin
|
||||
ListOfPCodeXYPosition:=aListOfPCodeXYPosition;
|
||||
if ListOfPCodeXYPosition=nil then begin
|
||||
DebugLn(['TAbstractMethodsDialog.Init ListOfPCodeXYPosition=nil']);
|
||||
exit;
|
||||
end;
|
||||
CodePos.Code:=aCode;
|
||||
CodePos.X:=aCaret.X;
|
||||
CodePos.Y:=aCaret.Y;
|
||||
TopLine:=aTopLine;
|
||||
|
||||
// get Tool and ClassNode
|
||||
Tool:=CodeToolBoss.GetCodeToolForSource(CodePos.Code,true,false) as TCodeTool;
|
||||
if Tool.CaretToCleanPos(CodePos,CleanPos)<>0 then begin
|
||||
DebugLn(['TAbstractMethodsDialog.Init invalid ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
|
||||
exit;
|
||||
end;
|
||||
ClassNode:=Tool.FindDeepestNodeAtPos(CleanPos,false);
|
||||
if ClassNode=nil then begin
|
||||
DebugLn(['TAbstractMethodsDialog.Init no node at cursor ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
|
||||
exit;
|
||||
end;
|
||||
if ClassNode.Desc=ctnTypeDefinition then
|
||||
ClassNode:=ClassNode.FirstChild
|
||||
else if ClassNode.Desc=ctnGenericType then
|
||||
ClassNode:=ClassNode.LastChild
|
||||
else
|
||||
ClassNode:=ClassNode.GetNodeOfTypes([ctnClass,ctnClassInterface]);
|
||||
if (ClassNode=nil) or (not (ClassNode.Desc in [ctnClass,ctnClassInterface]))
|
||||
then begin
|
||||
DebugLn(['TAbstractMethodsDialog.Init no class node at cursor ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
|
||||
exit;
|
||||
end;
|
||||
|
||||
StartClassName:=Tool.ExtractClassName(ClassNode,false);
|
||||
BelongsToStartClassCnt:=0;
|
||||
|
||||
// create items
|
||||
for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
|
||||
CodeXYPos:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
|
||||
CurTool:=CodeToolBoss.GetCodeToolForSource(CodeXYPos.Code,true,false) as TCodeTool;
|
||||
if CurTool.CaretToCleanPos(CodeXYPos,CleanPos)<>0 then begin
|
||||
DebugLn(['TAbstractMethodsDialog.Init skipping ',CodeXYPos.Code.Filename,' ',CodeXYPos.X,',',CodeXYPos.Y]);
|
||||
continue;
|
||||
end;
|
||||
CurNode:=CurTool.FindDeepestNodeAtPos(CleanPos,false);
|
||||
if CurNode=nil then begin
|
||||
DebugLn(['TAbstractMethodsDialog.Init no node at ',CodeXYPos.Code.Filename,' ',CodeXYPos.X,',',CodeXYPos.Y]);
|
||||
continue;
|
||||
end;
|
||||
if CurNode.Desc<>ctnProcedure then begin
|
||||
DebugLn(['TAbstractMethodsDialog.Init no proc node at ',CodeXYPos.Code.Filename,' ',CodeXYPos.X,',',CodeXYPos.Y]);
|
||||
continue;
|
||||
end;
|
||||
ProcNode:=CurNode;
|
||||
NewItem:=TAbstractMethodDlgItem.Create;
|
||||
NewItem.CodeXYPos:=CodeXYPos;
|
||||
NewItem.ProcHead:=CurTool.ExtractProcHead(ProcNode,[phpAddClassname,
|
||||
phpWithStart,phpWithParameterNames,phpWithVarModifiers,
|
||||
phpWithDefaultValues,phpWithResultType,
|
||||
phpWithOfObject,phpWithCallingSpecs]);
|
||||
NewItem.BelongsToStartClass:=ProcNode.HasAsParent(ClassNode);
|
||||
inc(BelongsToStartClassCnt);
|
||||
FItems.Add(NewItem);
|
||||
end;
|
||||
|
||||
MethodsCheckListBox.Clear;
|
||||
for i:=0 to FItems.Count-1 do begin
|
||||
NewItem:=TAbstractMethodDlgItem(FItems[i]);
|
||||
MethodsCheckListBox.Items.Add(NewItem.ProcHead);
|
||||
MethodsCheckListBox.Checked[i]:=not NewItem.BelongsToStartClass;
|
||||
end;
|
||||
|
||||
// caption
|
||||
Caption:='Abstract methods of '+ClassName;
|
||||
|
||||
// note
|
||||
NoteStr:='';
|
||||
if BelongsToStartClassCnt>0 then begin
|
||||
NoteStr:=StartClassName+' is an abstract class, it has '
|
||||
+IntToStr(BelongsToStartClassCnt)+' abstract methods.'#13;
|
||||
end;
|
||||
NoteStr:=NoteStr+'There are '+IntToStr(FItems.Count-BelongsToStartClassCnt)
|
||||
+' abstract methods to override.'#13
|
||||
+'Select the methods for which stubs should be created:';
|
||||
NoteLabel.Caption:=NoteStr;
|
||||
|
||||
UpdateButtons;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I abstractsmethodsdlg.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
11
ide/main.pp
11
ide/main.pp
@ -129,7 +129,7 @@ uses
|
||||
BuildLazDialog, MiscOptions, InputHistory, UnitDependencies, ClipBoardHistory,
|
||||
ProcessList, InitialSetupDlgs, NewDialog, MakeResStrDlg, ToDoList,
|
||||
DialogProcs, FindReplaceDialog, FindInFilesDlg, CodeExplorer, BuildFileDlg,
|
||||
ProcedureList, ExtractProcDlg, FindRenameIdentifier,
|
||||
ProcedureList, ExtractProcDlg, FindRenameIdentifier, AbstractsMethodsDlg,
|
||||
CleanDirDlg, CodeContextForm, AboutFrm, BuildManager,
|
||||
// main ide
|
||||
MainBar, MainIntf, MainBase;
|
||||
@ -835,6 +835,7 @@ type
|
||||
procedure DoFindDeclarationAtCursor;
|
||||
procedure DoFindDeclarationAtCaret(const LogCaretXY: TPoint);
|
||||
function DoFindRenameIdentifier(Rename: boolean): TModalResult;
|
||||
function DoShowAbstractMethods: TModalResult;
|
||||
function DoInitIdentCompletion(JumpToError: boolean): boolean;
|
||||
function DoShowCodeContext(JumpToError: boolean): boolean;
|
||||
procedure DoCompleteCodeAtCursor;
|
||||
@ -2565,6 +2566,9 @@ begin
|
||||
ecRenameIdentifier:
|
||||
DoFindRenameIdentifier(true);
|
||||
|
||||
ecShowAbstractMethods:
|
||||
DoShowAbstractMethods;
|
||||
|
||||
ecFindBlockOtherEnd:
|
||||
DoGoToPascalBlockOtherEnd;
|
||||
|
||||
@ -11531,6 +11535,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMainIDE.DoShowAbstractMethods: TModalResult;
|
||||
begin
|
||||
Result:=ShowAbstractMethodsDialog;
|
||||
end;
|
||||
|
||||
{-------------------------------------------------------------------------------
|
||||
function TMainIDE.DoInitIdentCompletion(JumpToError: boolean): boolean;
|
||||
-------------------------------------------------------------------------------}
|
||||
|
@ -417,7 +417,7 @@ type
|
||||
procedure InvertAssignmentMenuItemClick(Sender: TObject);
|
||||
procedure FindIdentifierReferencesMenuItemClick(Sender: TObject);
|
||||
procedure RenameIdentifierMenuItemClick(Sender: TObject);
|
||||
//procedure ShowAbstractMethodsMenuItemClick(Sender: TObject);
|
||||
procedure ShowAbstractMethodsMenuItemClick(Sender: TObject);
|
||||
procedure RunToClicked(Sender: TObject);
|
||||
procedure ViewCallStackClick(Sender: TObject);
|
||||
procedure AddWatchAtCursor(Sender: TObject);
|
||||
@ -833,6 +833,7 @@ var
|
||||
SrcEditMenuFindIdentifierReferences: TIDEMenuCommand;
|
||||
SrcEditMenuExtractProc: TIDEMenuCommand;
|
||||
SrcEditMenuInvertAssignment: TIDEMenuCommand;
|
||||
SrcEditMenuShowAbstractMethods: TIDEMenuCommand;
|
||||
SrcEditMenuInsertTodo: TIDEMenuCommand;
|
||||
SrcEditMenuMoveEditorLeft: TIDEMenuCommand;
|
||||
SrcEditMenuMoveEditorRight: TIDEMenuCommand;
|
||||
@ -979,6 +980,8 @@ begin
|
||||
'ExtractProc',uemExtractProc);
|
||||
SrcEditMenuInvertAssignment:=RegisterIDEMenuCommand(AParent,
|
||||
'InvertAssignment',uemInvertAssignment);
|
||||
SrcEditMenuShowAbstractMethods:=RegisterIDEMenuCommand(AParent,
|
||||
'ShowAbstractMethods',srkmecShowAbstractMethods);
|
||||
|
||||
SrcEditMenuInsertTodo:=RegisterIDEMenuCommand(SourceEditorMenuRoot,
|
||||
'InsertTodo',uemInsertTodo, nil, nil, nil, 'item_todo');
|
||||
@ -3868,6 +3871,7 @@ begin
|
||||
SrcEditMenuRenameIdentifier.Enabled:=
|
||||
IsValidIdent(ASrcEdit.GetWordAtCurrentCaret)
|
||||
and (not ASrcEdit.ReadOnly);
|
||||
SrcEditMenuShowAbstractMethods.Enabled:=not ASrcEdit.ReadOnly;
|
||||
end else begin
|
||||
// user clicked on gutter
|
||||
SourceEditorMarks.GetMarksForLine(EditorComp,EditorComp.CaretY,
|
||||
@ -4022,6 +4026,7 @@ begin
|
||||
SrcEditMenuFindIdentifierReferences.OnClick:=
|
||||
@FindIdentifierReferencesMenuItemClick;
|
||||
SrcEditMenuRenameIdentifier.OnClick:=@RenameIdentifierMenuItemClick;
|
||||
SrcEditMenuShowAbstractMethods.OnClick:=@ShowAbstractMethodsMenuItemClick;
|
||||
|
||||
SrcEditMenuReadOnly.OnClick:=@ReadOnlyClicked;
|
||||
SrcEditMenuShowLineNumbers.OnClick:=@ToggleLineNumbersClicked;
|
||||
@ -5112,6 +5117,11 @@ begin
|
||||
MainIDEInterface.DoCommand(ecRenameIdentifier);
|
||||
end;
|
||||
|
||||
procedure TSourceNotebook.ShowAbstractMethodsMenuItemClick(Sender: TObject);
|
||||
begin
|
||||
MainIDEInterface.DoCommand(ecShowAbstractMethods);
|
||||
end;
|
||||
|
||||
procedure TSourceNotebook.RunToClicked(Sender: TObject);
|
||||
var
|
||||
ASrcEdit: TSourceEditor;
|
||||
|
Loading…
Reference in New Issue
Block a user