mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-19 08:03:11 +02:00
667 lines
25 KiB
ObjectPascal
667 lines
25 KiB
ObjectPascal
{
|
|
***************************************************************************
|
|
* *
|
|
* 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:
|
|
TEventsCodeTool enhances TMethodJumpingCodeTool.
|
|
TEventsCodeTool provides functions to work with published methods in the
|
|
source. It can gather a list of compatible methods, test if method exists,
|
|
jump to the method body, create a method
|
|
}
|
|
unit EventCodeTool;
|
|
|
|
{$ifdef FPC}{$mode objfpc}{$endif}{$H+}
|
|
|
|
interface
|
|
|
|
{$I codetools.inc}
|
|
|
|
uses
|
|
{$IFDEF MEM_CHECK}
|
|
MemCheck,
|
|
{$ENDIF}
|
|
Classes, SysUtils, CodeTree, CodeAtom, PascalParserTool, MethodJumpTool,
|
|
SourceLog, KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache, AVL_Tree,
|
|
TypInfo, SourceChanger;
|
|
|
|
type
|
|
TGetStringProc = procedure(const s: string) of object;
|
|
|
|
TEventsCodeTool = class(TMethodJumpingCodeTool)
|
|
protected
|
|
function InsertNewMethodToClass(ClassSectionNode: TCodeTreeNode;
|
|
const AMethodName,NewMethod: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
public
|
|
procedure GetCompatiblePublishedMethods(const UpperClassName: string;
|
|
TypeData: PTypeData; Proc: TGetStringProc);
|
|
procedure GetCompatiblePublishedMethods(ClassNode: TCodeTreeNode;
|
|
TypeData: PTypeData; Proc: TGetStringProc);
|
|
function PublishedMethodExists(const UpperClassName,
|
|
UpperMethodName: string; TypeData: PTypeData): boolean;
|
|
function PublishedMethodExists(ClassNode: TCodeTreeNode;
|
|
const UpperMethodName: string; TypeData: PTypeData): boolean;
|
|
function JumpToPublishedMethodBody(const UpperClassName,
|
|
UpperMethodName: string; TypeData: PTypeData;
|
|
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
|
function RenamePublishedMethod(const UpperClassName, UpperOldMethodName,
|
|
NewMethodName: string; TypeData: PTypeData;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function RenamePublishedMethod(ClassNode: TCodeTreeNode;
|
|
const UpperOldMethodName, NewMethodName: string; TypeData: PTypeData;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function CreatePublishedMethod(const UpperClassName,
|
|
AMethodName: string; TypeData: PTypeData;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
function CreatePublishedMethod(ClassNode: TCodeTreeNode;
|
|
const AMethodName: string; TypeData: PTypeData;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
|
|
function MethodTypeDataToStr(TypeData: PTypeData;
|
|
Attr: TProcHeadAttributes): string;
|
|
function FindPublishedMethodNodeInClass(ClassNode: TCodeTreeNode;
|
|
const UpperMethodName: string; TypeData: PTypeData): TCodeTreeNode;
|
|
function FindProcNodeInImplementation(const UpperClassName,
|
|
UpperMethodName: string; TypeData: PTypeData;
|
|
BuildTreeBefore: boolean): TCodeTreeNode;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
const
|
|
MethodKindAsString: array[TMethodKind] of shortstring = (
|
|
'procedure', 'function', 'constructor', 'destructor',
|
|
'class procedure', 'class function'
|
|
);
|
|
|
|
|
|
{ TEventsCodeTool }
|
|
|
|
function TEventsCodeTool.MethodTypeDataToStr(TypeData: PTypeData;
|
|
Attr: TProcHeadAttributes): string;
|
|
type
|
|
TParamType = record
|
|
Flags: TParamFlags;
|
|
ParamName: ShortString;
|
|
TypeName: ShortString;
|
|
end;
|
|
|
|
var i, ParamCount, Len, Offset: integer;
|
|
ParamType: TParamType;
|
|
s, ParamString: string;
|
|
begin
|
|
Result:='';
|
|
if TypeData=nil then exit;
|
|
// transform TypeData into a ProcHead String
|
|
ParamCount:=TypeData^.ParamCount;
|
|
//writeln('TEventsCodeTool.MethodTypeDataToStr A ParamCount=',ParamCount);
|
|
if ParamCount>0 then begin
|
|
Result:=Result+'(';
|
|
ParamString:='';
|
|
Offset:=0;
|
|
for i:=0 to ParamCount-1 do begin
|
|
// read ParamFlags
|
|
// XXX ToDo strange: SizeOf(TParamFlags) is 4, but the data is only 1
|
|
Len:=1; // SizeOf(TParamFlags)
|
|
Move(TypeData^.ParamList[Offset],ParamType.Flags,Len);
|
|
inc(Offset,Len);
|
|
|
|
// read ParamName
|
|
Len:=ord(TypeData^.ParamList[Offset]);
|
|
inc(Offset);
|
|
SetLength(ParamType.ParamName,Len);
|
|
Move(TypeData^.ParamList[Offset],ParamType.ParamName[1],Len);
|
|
inc(Offset,Len);
|
|
if ParamType.ParamName='' then begin
|
|
if ParamCount>1 then
|
|
ParamType.ParamName:='AValue'+IntToStr(ParamCount-i)
|
|
else
|
|
ParamType.ParamName:='AValue';
|
|
end;
|
|
|
|
// read ParamType
|
|
Len:=ord(TypeData^.ParamList[Offset]);
|
|
inc(Offset);
|
|
SetLength(ParamType.TypeName,Len);
|
|
Move(TypeData^.ParamList[Offset],ParamType.TypeName[1],Len);
|
|
inc(Offset,Len);
|
|
|
|
// build string
|
|
if phpWithVarModifiers in Attr then begin
|
|
if pfVar in ParamType.Flags then
|
|
s:='var '
|
|
else if pfConst in ParamType.Flags then
|
|
s:='const '
|
|
else if pfOut in ParamType.Flags then
|
|
s:='out '
|
|
else
|
|
s:='';
|
|
end else
|
|
s:='';
|
|
if phpWithParameterNames in Attr then
|
|
s:=s+ParamType.ParamName;
|
|
s:=s+':'+ParamType.TypeName;
|
|
if i>0 then s:=s+';';
|
|
ParamString:=s+ParamString;
|
|
end;
|
|
Result:=Result+ParamString+')';
|
|
end;
|
|
if phpInUpperCase in Attr then Result:=UpperCaseStr(Result);
|
|
Result:=Result+';';
|
|
end;
|
|
|
|
procedure TEventsCodeTool.GetCompatiblePublishedMethods(
|
|
const UpperClassName: string; TypeData: PTypeData; Proc: TGetStringProc);
|
|
var ClassNode: TCodeTreeNode;
|
|
begin
|
|
BuildTree(true);
|
|
if not InterfaceSectionFound then exit;
|
|
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
|
|
GetCompatiblePublishedMethods(ClassNode,TypeData,Proc);
|
|
end;
|
|
|
|
procedure TEventsCodeTool.GetCompatiblePublishedMethods(
|
|
ClassNode: TCodeTreeNode; TypeData: PTypeData; Proc: TGetStringProc);
|
|
var SearchedProc: string;
|
|
SectionNode, ANode: TCodeTreeNode;
|
|
CurProcHead, CurProcName: string;
|
|
begin
|
|
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (TypeData=nil)
|
|
or (Proc=nil) then exit;
|
|
BuildSubTreeForClass(ClassNode);
|
|
SearchedProc:=MethodTypeDataToStr(TypeData,[phpInUpperCase]);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.GetCompatibleMethods] SearchedProc="',SearchedProc,'"');
|
|
{$ENDIF}
|
|
SectionNode:=ClassNode.FirstChild;
|
|
while (SectionNode<>nil) do begin
|
|
while (SectionNode.Desc<>ctnClassPublished) or (SectionNode.FirstChild=nil)
|
|
do begin
|
|
SectionNode:=SectionNode.NextBrother;
|
|
if SectionNode=nil then exit;
|
|
end;
|
|
ANode:=SectionNode.FirstChild;
|
|
repeat
|
|
if (ANode.Desc=ctnProcedure) then begin
|
|
CurProcHead:=ExtractProcHead(ANode,[phpInUpperCase,phpWithoutName]);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.GetCompatibleMethods] CurProcName="',CurProcHead,'"');
|
|
{$ENDIF}
|
|
if (CurProcHead<>'')
|
|
and (CompareTextIgnoringSpace(CurProcHead,SearchedProc,true)=0) then
|
|
begin
|
|
CurProcName:=ExtractProcName(ANode,false);
|
|
if (CurProcName<>'') and (length(CurProcName)<256) then
|
|
Proc(CurProcName);
|
|
end;
|
|
end;
|
|
ANode:=ANode.NextBrother;
|
|
until ANode=nil;
|
|
SectionNode:=SectionNode.NextBrother;
|
|
end;
|
|
end;
|
|
|
|
function TEventsCodeTool.FindPublishedMethodNodeInClass(
|
|
ClassNode: TCodeTreeNode; const UpperMethodName: string;
|
|
TypeData: PTypeData): TCodeTreeNode;
|
|
var
|
|
SectionNode, ANode: TCodeTreeNode;
|
|
SearchedProcHead, CurProcHead: string;
|
|
begin
|
|
Result:=nil;
|
|
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (UpperMethodName='')
|
|
or (Scanner=nil) or (TypeData=nil) then exit;
|
|
SearchedProcHead:=UpperMethodName+MethodTypeDataToStr(TypeData,
|
|
[phpInUpperCase]);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TEventsCodeTool.FindPublishedMethodNodeInClass A SearchedProcHead="',
|
|
SearchedProcHead,'"');
|
|
{$ENDIF}
|
|
BuildSubTreeForClass(ClassNode);
|
|
SectionNode:=ClassNode.FirstChild;
|
|
while (SectionNode<>nil) do begin
|
|
while (SectionNode.Desc<>ctnClassPublished) or (SectionNode.FirstChild=nil)
|
|
do begin
|
|
SectionNode:=SectionNode.NextBrother;
|
|
if SectionNode=nil then exit;
|
|
end;
|
|
ANode:=SectionNode.FirstChild;
|
|
repeat
|
|
if (ANode.Desc=ctnProcedure) then begin
|
|
CurProcHead:=ExtractProcHead(ANode,[phpInUpperCase]);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TEventsCodeTool.FindPublishedMethodNodeInClass "',SearchedProcHead,
|
|
'"="',CurProcHead,'"');
|
|
{$ENDIF}
|
|
if (CurProcHead<>'')
|
|
and (CompareTextIgnoringSpace(CurProcHead,SearchedProcHead,true)=0) then
|
|
begin
|
|
Result:=ANode;
|
|
exit;
|
|
end;
|
|
end;
|
|
ANode:=ANode.NextBrother;
|
|
until ANode=nil;
|
|
SectionNode:=SectionNode.NextBrother;
|
|
end;
|
|
end;
|
|
|
|
function TEventsCodeTool.FindProcNodeInImplementation(const UpperClassName,
|
|
UpperMethodName: string; TypeData: PTypeData;
|
|
BuildTreeBefore: boolean): TCodeTreeNode;
|
|
var SectionNode, ANode: TCodeTreeNode;
|
|
SearchedProcHead, CurProcHead: string;
|
|
begin
|
|
Result:=nil;
|
|
if BuildTreeBefore then BuildTree(false);
|
|
// find implementation node
|
|
SectionNode:=Tree.Root;
|
|
while (SectionNode<>nil) and (SectionNode.Desc<>ctnImplementation) do
|
|
SectionNode:=SectionNode.NextBrother;
|
|
if SectionNode=nil then exit;
|
|
ANode:=SectionNode.FirstChild;
|
|
SearchedProcHead:=UpperClassName+'.'+UpperMethodName
|
|
+MethodTypeDataToStr(TypeData,[phpInUpperCase,phpWithParameterNames]);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.FindProcNodeInImplementation] SearchedProcHead=',SearchedProcHead);
|
|
{$ENDIF}
|
|
while (ANode<>nil) do begin
|
|
if (ANode.Desc=ctnProcedure) then begin
|
|
CurProcHead:=ExtractProcHead(ANode,[phpInUpperCase]);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.FindProcNodeInImplementation] CurProcHead=',CurProcHead);
|
|
{$ENDIF}
|
|
if (CurProcHead<>'')
|
|
and (CompareTextIgnoringSpace(CurProcHead,SearchedProcHead,true)=0) then
|
|
begin
|
|
Result:=ANode;
|
|
exit;
|
|
end;
|
|
end;
|
|
ANode:=ANode.NextBrother;
|
|
end;
|
|
end;
|
|
|
|
function TEventsCodeTool.PublishedMethodExists(const UpperClassName,
|
|
UpperMethodName: string; TypeData: PTypeData): boolean;
|
|
var ClassNode: TCodeTreeNode;
|
|
begin
|
|
BuildTree(true);
|
|
if not InterfaceSectionFound then exit;
|
|
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
|
|
Result:=PublishedMethodExists(ClassNode,UpperMethodName,TypeData);
|
|
end;
|
|
|
|
function TEventsCodeTool.PublishedMethodExists(ClassNode: TCodeTreeNode;
|
|
const UpperMethodName: string; TypeData: PTypeData): boolean;
|
|
begin
|
|
Result:=(FindPublishedMethodNodeInClass(ClassNode,UpperMethodName,TypeData)
|
|
<>nil);
|
|
end;
|
|
|
|
function TEventsCodeTool.JumpToPublishedMethodBody(const UpperClassName,
|
|
UpperMethodName: string; TypeData: PTypeData;
|
|
var NewPos: TCodeXYPosition; var NewTopLine: integer): boolean;
|
|
var ANode: TCodeTreeNode;
|
|
begin
|
|
Result:=false;
|
|
ANode:=FindProcNodeInImplementation(UpperClassName,UpperMethodName,TypeData,
|
|
true);
|
|
Result:=FindJumpPointInProcNode(ANode,NewPos,NewTopLine);
|
|
end;
|
|
|
|
function TEventsCodeTool.RenamePublishedMethod(const UpperClassName,
|
|
UpperOldMethodName, NewMethodName: string; TypeData: PTypeData;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var ClassNode: TCodeTreeNode;
|
|
begin
|
|
BuildTree(false);
|
|
if not EndOfSourceFound then exit;
|
|
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
|
|
Result:=RenamePublishedMethod(ClassNode,UpperOldMethodName,NewMethodName,
|
|
TypeData,SourceChangeCache);
|
|
end;
|
|
|
|
function TEventsCodeTool.RenamePublishedMethod(ClassNode: TCodeTreeNode;
|
|
const UpperOldMethodName, NewMethodName: string; TypeData: PTypeData;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
// rename published method in class and in procedure itself
|
|
var ANode, ProcHeadNode: TCodeTreeNode;
|
|
NameStart, NameEnd: integer;
|
|
UpperClassName: string;
|
|
begin
|
|
Result:=false;
|
|
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (UpperOldMethodName='')
|
|
or (NewMethodName='') or (SourceChangeCache=nil) or (Scanner=nil)
|
|
or (TypeData=nil) then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
// rename in class
|
|
ANode:=FindPublishedMethodNodeInClass(ClassNode,UpperOldMethodName,TypeData);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TEventsCodeTool.RenamePublishedMethod A ',ANode<>nil);
|
|
{$ENDIF}
|
|
if ANode=nil then exit;
|
|
ProcHeadNode:=ANode.FirstChild;
|
|
if ProcHeadNode=nil then exit;
|
|
NameStart:=ProcHeadNode.StartPos;
|
|
NameEnd:=NameStart;
|
|
while (NameEnd<=SrcLen) and (IsIdentChar[UpperSrc[NameEnd]]) do
|
|
inc(NameEnd);
|
|
if not SourceChangeCache.Replace(gtNone,gtNone,NameStart,NameEnd,
|
|
NewMethodName) then exit;
|
|
// rename procedure itself -> find implementation node
|
|
UpperClassName:=ExtractClassName(ClassNode,true);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TEventsCodeTool.RenamePublishedMethod B ClassName=',UpperClassName);
|
|
{$ENDIF}
|
|
ANode:=FindProcNodeInImplementation(UpperClassName,UpperOldMethodName,
|
|
TypeData,false);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TEventsCodeTool.RenamePublishedMethod C ',ANode<>nil);
|
|
{$ENDIF}
|
|
if ANode=nil then exit;
|
|
ProcHeadNode:=ANode.FirstChild;
|
|
if ProcHeadNode=nil then exit;
|
|
MoveCursorToNodeStart(ProcHeadNode);
|
|
ReadNextAtom; // read class name
|
|
ReadNextAtom; // read '.'
|
|
ReadNextAtom; // read method name
|
|
{$IFDEF CTDEBUG}
|
|
writeln('TEventsCodeTool.RenamePublishedMethod D "',GetAtom,'"');
|
|
{$ENDIF}
|
|
Result:=SourceChangeCache.Replace(gtNone,gtNone,
|
|
CurPos.StartPos,CurPos.EndPos,NewMethodName);
|
|
end;
|
|
|
|
function TEventsCodeTool.CreatePublishedMethod(const UpperClassName,
|
|
AMethodName: string; TypeData: PTypeData;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var ClassNode: TCodeTreeNode;
|
|
begin
|
|
BuildTree(false);
|
|
if not EndOfSourceFound then exit;
|
|
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
|
|
Result:=CreatePublishedMethod(ClassNode,AMethodName,TypeData,
|
|
SourceChangeCache);
|
|
end;
|
|
|
|
function TEventsCodeTool.CreatePublishedMethod(ClassNode: TCodeTreeNode;
|
|
const AMethodName: string; TypeData: PTypeData;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
var PublishedNode: TCodeTreeNode;
|
|
NewMethod: string;
|
|
begin
|
|
Result:=false;
|
|
if (ClassNode=nil) or (ClassNode.Desc<>ctnClass) or (AMethodName='')
|
|
or (TypeData=nil) or (SourceChangeCache=nil) or (Scanner=nil) then exit;
|
|
SourceChangeCache.MainScanner:=Scanner;
|
|
// add method to published section
|
|
BuildSubTreeForClass(ClassNode);
|
|
PublishedNode:=ClassNode.FirstChild;
|
|
if PublishedNode=nil then exit;
|
|
if (PublishedNode.StartPos=PublishedNode.EndPos)
|
|
and (PublishedNode.NextBrother<>nil)
|
|
and (PublishedNode.NextBrother.Desc=ctnClassPublished) then
|
|
PublishedNode:=PublishedNode.NextBrother;
|
|
NewMethod:=MethodKindAsString[TypeData^.MethodKind]+' '+AMethodName+
|
|
MethodTypeDataToStr(TypeData,[phpWithVarModifiers,phpWithParameterNames]);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.CreatePublishedMethod] A NewMethod="',NewMethod,'"');
|
|
{$ENDIF}
|
|
Result:=InsertNewMethodToClass(PublishedNode,AMethodName,NewMethod,
|
|
SourceChangeCache);
|
|
end;
|
|
|
|
function TEventsCodeTool.InsertNewMethodToClass(
|
|
ClassSectionNode: TCodeTreeNode; const AMethodName,NewMethod: string;
|
|
SourceChangeCache: TSourceChangeCache): boolean;
|
|
// NewMethod is for example 'class function Lol(c: char): char;'
|
|
var InsertNode, ClassNode, ImplementationNode, StartNode, ANode: TCodeTreeNode;
|
|
Indent, InsertPos, cmp, WordStart, WordEnd: integer;
|
|
UpperMethodName, CurProcName, ProcCode, UpperClassName, CurWord,
|
|
AClassName: string;
|
|
StartClassCode: boolean;
|
|
ClassBodyProcs: TAVLTree;
|
|
AnAVLNode: TAVLTreeNode;
|
|
begin
|
|
Result:=false;
|
|
if (ClassSectionNode=nil) or (SourceChangeCache=nil) or (AMethodName='')
|
|
or (NewMethod='') then exit;
|
|
ClassNode:=ClassSectionNode.Parent;
|
|
if ClassNode=nil then exit;
|
|
AClassName:=ExtractClassName(ClassNode,false);
|
|
UpperClassName:=UpperCaseStr(AClassName);
|
|
UpperMethodName:=UpperCaseStr(AMethodName);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] A ',
|
|
ClassSectionNode.FirstChild<>nil,' "',NewMethod,'"');
|
|
{$ENDIF}
|
|
// find a nice inserting position
|
|
if ClassSectionNode.FirstChild<>nil then begin
|
|
// there are already other child nodes
|
|
if (cpipLast=SourceChangeCache.BeautifyCodeOptions.ClassPartInsertPolicy)
|
|
then begin
|
|
// insert as last
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] B');
|
|
{$ENDIF}
|
|
InsertNode:=ClassSectionNode.LastChild;
|
|
Indent:=GetLineIndent(Src,InsertNode.StartPos);
|
|
InsertPos:=FindFirstLineEndAfterInCode(Src,InsertNode.EndPos,
|
|
Scanner.NestedComments);
|
|
end else begin
|
|
// insert alphabetically
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] C');
|
|
{$ENDIF}
|
|
InsertNode:=ClassSectionNode.FirstChild;
|
|
while (InsertNode<>nil) do begin
|
|
if (InsertNode.Desc=ctnProcedure) then begin
|
|
CurProcName:=ExtractProcName(InsertNode,true);
|
|
if CurProcName>UpperMethodName then
|
|
break;
|
|
end;
|
|
InsertNode:=InsertNode.NextBrother;
|
|
end;
|
|
if InsertNode<>nil then begin
|
|
// insert before insertnode
|
|
if InsertNode.PriorBrother<>nil then begin
|
|
// insert after InsertNode.PriorBrother
|
|
InsertNode:=InsertNode.PriorBrother;
|
|
Indent:=GetLineIndent(Src,InsertNode.StartPos);
|
|
InsertPos:=FindFirstLineEndAfterInCode(Src,InsertNode.EndPos,
|
|
Scanner.NestedComments);
|
|
end else begin
|
|
// insert as first
|
|
Indent:=GetLineIndent(Src,InsertNode.StartPos);
|
|
InsertPos:=FindFirstLineEndAfterInCode(Src,
|
|
ClassSectionNode.EndPos,Scanner.NestedComments);
|
|
end;
|
|
end else begin
|
|
// insert as last
|
|
InsertNode:=ClassSectionNode.LastChild;
|
|
Indent:=GetLineIndent(Src,InsertNode.StartPos);
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(Src,InsertNode.EndPos,
|
|
Scanner.NestedComments);
|
|
end;
|
|
end;
|
|
end else begin
|
|
// will become first and only child node of section
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] D');
|
|
{$ENDIF}
|
|
Indent:=GetLineIndent(Src,ClassSectionNode.StartPos)
|
|
+SourceChangeCache.BeautifyCodeOptions.Indent;
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
|
|
ClassSectionNode.StartPos,Scanner.NestedComments);
|
|
end;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] E');
|
|
{$ENDIF}
|
|
ProcCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyProc(NewMethod,
|
|
Indent,false);
|
|
if not SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
|
|
ProcCode) then exit;
|
|
|
|
// add method body to implementation section
|
|
|
|
ImplementationNode:=Tree.Root;
|
|
while (ImplementationNode<>nil)
|
|
and (ImplementationNode.Desc<>ctnImplementation) do
|
|
ImplementationNode:=ImplementationNode.NextBrother;
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] F ',ImplementationNode<>nil);
|
|
{$ENDIF}
|
|
if ImplementationNode=nil then exit;
|
|
StartNode:=ImplementationNode.FirstChild;
|
|
if StartNode<>nil then begin
|
|
// implementation section contains some procs or classes
|
|
|
|
// gather proc nodes in implementation section
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] G');
|
|
{$ENDIF}
|
|
ClassBodyProcs:=GatherProcNodes(StartNode,
|
|
[phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname,
|
|
phpWithoutClassName],UpperClassName);
|
|
StartClassCode:=(ClassBodyProcs.Count=0);
|
|
UpperMethodName:=UpperClassName+'.'+UpperMethodName;
|
|
if not StartClassCode then begin
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] H');
|
|
{$ENDIF}
|
|
// find a nice insert position for the proc body
|
|
case SourceChangeCache.BeautifyCodeOptions.ProcedureInsertPolicy of
|
|
pipAlphabetically:
|
|
// insert proc in alphabetic order
|
|
begin
|
|
AnAVLNode:=ClassBodyProcs.Root;
|
|
while AnAVLNode<>nil do begin
|
|
InsertNode:=TCodeTreeNodeExtension(AnAVLNode.Data).Node;
|
|
CurProcName:=ExtractProcName(InsertNode,true);
|
|
cmp:=AnsiCompareStr(UpperMethodName,CurProcName);
|
|
if cmp<0 then
|
|
AnAVLNode:=AnAVLNode.Left
|
|
else if cmp>0 then
|
|
AnAVLNode:=AnAVLNode.Right
|
|
else
|
|
break;
|
|
end;
|
|
repeat
|
|
AnAVLNode:=ClassBodyProcs.FindSuccessor(AnAVLNode);
|
|
if AnAVLNode=nil then break;
|
|
ANode:=TCodeTreeNodeExtension(AnAVLNode.Data).Node;
|
|
CurProcName:=ExtractProcName(ANode,true);
|
|
cmp:=AnsiCompareStr(UpperMethodName,CurProcName);
|
|
if cmp=0 then
|
|
InsertNode:=ANode;
|
|
until cmp<>0;
|
|
CurProcName:=ExtractProcName(InsertNode,true);
|
|
cmp:=AnsiCompareStr(UpperMethodName,CurProcName);
|
|
if cmp<0 then begin
|
|
// insert in front of InsertNode
|
|
Indent:=GetLineIndent(Src,InsertNode.StartPos);
|
|
InsertPos:=FindLineEndOrCodeInFrontOfPosition(Src,
|
|
InsertNode.StartPos-1,Scanner.NestedComments);
|
|
if InsertPos<1 then InsertPos:=1;
|
|
end else begin
|
|
// insert behind InsertNode
|
|
Indent:=GetLineIndent(Src,InsertNode.StartPos);
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
|
|
InsertNode.EndPos,Scanner.NestedComments);
|
|
end;
|
|
end;
|
|
else // pipLast:
|
|
// insert proc body behind last proc body
|
|
begin
|
|
AnAVLNode:=ClassBodyProcs.FindLowest;
|
|
InsertNode:=TCodeTreeNodeExtension(AnAVLNode.Data).Node;
|
|
while (AnAVLNode<>nil) do begin
|
|
ANode:=TCodeTreeNodeExtension(AnAVLNode.Data).Node;
|
|
if InsertNode.StartPos<ANode.StartPos then
|
|
InsertNode:=ANode;
|
|
AnAVLNode:=ClassBodyProcs.FindSuccessor(AnAVLNode);
|
|
end;
|
|
// insert after InsertNode
|
|
Indent:=GetLineIndent(Src,InsertNode.StartPos);
|
|
InsertPos:=FindLineEndOrCodeAfterPosition(Src,
|
|
InsertNode.EndPos,Scanner.NestedComments);
|
|
end;
|
|
end;
|
|
end else begin
|
|
// this is the first class body
|
|
// -> add proc body at the end of the implementation section
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] I');
|
|
{$ENDIF}
|
|
Indent:=GetLineIndent(Src,InsertNode.StartPos);
|
|
InsertPos:=ImplementationNode.EndPos;
|
|
end;
|
|
end else begin
|
|
// implementation section contains no procs or classes
|
|
// -> add proc body at the end of the implementation section
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] J');
|
|
{$ENDIF}
|
|
StartClassCode:=true;
|
|
Indent:=GetLineIndent(Src,ImplementationNode.StartPos);
|
|
InsertPos:=ImplementationNode.EndPos;
|
|
end;
|
|
|
|
// insert classname to Method string
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] K');
|
|
{$ENDIF}
|
|
WordEnd:=1;
|
|
repeat
|
|
WordStart:=WordEnd;
|
|
while (WordStart<=length(NewMethod)) and (IsSpaceChar[NewMethod[WordStart]])
|
|
do inc(WordStart);
|
|
WordEnd:=WordStart;
|
|
while (WordEnd<=length(NewMethod)) and (IsIdentChar[NewMethod[WordEnd]])
|
|
do inc(WordEnd);
|
|
CurWord:=UpperCaseStr(copy(NewMethod,WordStart,WordEnd-WordStart));
|
|
until (CurWord<>'PROCEDURE') and (CurWord<>'FUNCTION') and (CurWord<>'CLASS')
|
|
and (CurWord<>'CONSTRUCTOR') and (CurWord<>'DESTRUCTOR');
|
|
ProcCode:=copy(NewMethod,1,WordStart-1)+AClassName+'.'
|
|
+copy(NewMethod,WordStart,length(NewMethod)-WordStart+1);
|
|
{$IFDEF CTDEBUG}
|
|
writeln('[TEventsCodeTool.InsertNewMethodToClass] L');
|
|
{$ENDIF}
|
|
// build nice proc
|
|
ProcCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyProc(ProcCode,
|
|
Indent,true);
|
|
if StartClassCode then
|
|
ProcCode:=SourceChangeCache.BeautifyCodeOptions.LineEnd
|
|
+GetIndentStr(Indent)+'{ '+AClassName+' }'
|
|
+SourceChangeCache.BeautifyCodeOptions.LineEnd
|
|
+ProcCode;
|
|
if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
|
|
ProcCode) then exit;
|
|
|
|
Result:=true;
|
|
end;
|
|
|
|
|
|
end.
|
|
|