mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-02 16:39:56 +01:00
codetools: started nested classes, replaced ctnClassType with ctnTypeSection, ctnClassConst with ctnConstSection, class type,const,var sections are now childs of visibility sections
git-svn-id: trunk@29390 -
This commit is contained in:
mattias
parent
f714457e24
commit
3943d23f9b
@ -1530,7 +1530,7 @@ var
|
||||
ProcNode:=CursorNode;
|
||||
while (ProcNode<>nil) do begin
|
||||
if (ProcNode.Desc=ctnProcedure) then begin
|
||||
SearchedClassname:=ExtractClassNameOfProcNode(ProcNode);
|
||||
SearchedClassname:=ExtractClassNameOfProcNode(ProcNode,true);
|
||||
if SearchedClassName<>'' then break;
|
||||
end;
|
||||
ProcNode:=ProcNode.Parent;
|
||||
@ -1591,7 +1591,7 @@ var
|
||||
end;
|
||||
MethodDefinition:=SourceChangeCache.BeautifyCodeOptions.
|
||||
AddClassAndNameToProc(MethodDefinition,
|
||||
ExtractClassName(AClassNode,false), AnEventName);
|
||||
ExtractClassName(AClassNode,false,true), AnEventName);
|
||||
if not InsertAllNewClassParts then
|
||||
RaiseException(ctsErrorDuringInsertingNewClassParts);
|
||||
|
||||
@ -5873,7 +5873,7 @@ begin
|
||||
else
|
||||
Indent:=GetLineIndent(Src,ClassSectionNode.Parent.StartPos)
|
||||
+ASourceChangeCache.BeautifyCodeOptions.Indent;
|
||||
end else if (ClassSectionNode.Desc in (AllClassBaseSections+[ctnClassType]))
|
||||
end else if (ClassSectionNode.Desc in AllClassBaseSections)
|
||||
then begin
|
||||
// skip keyword
|
||||
MoveCursorToCleanPos(InsertPos);
|
||||
|
||||
@ -96,16 +96,13 @@ const
|
||||
ctnClassExternal = 42;
|
||||
ctnClassInheritance = 43;
|
||||
ctnClassGUID = 44;
|
||||
ctnClassConst = 45;
|
||||
ctnClassType = 46;
|
||||
ctnClassVar = 47;
|
||||
ctnClassClassVar = 48;
|
||||
ctnClassPrivate = 49;
|
||||
ctnClassProtected = 50;
|
||||
ctnClassPublic = 51;
|
||||
ctnClassPublished = 52;
|
||||
ctnProperty = 53;
|
||||
ctnMethodMap = 54;
|
||||
ctnClassClassVar = 45; // child of visibility section
|
||||
ctnClassPrivate = 46; // child of AllClassObjects
|
||||
ctnClassProtected = 47;
|
||||
ctnClassPublic = 48;
|
||||
ctnClassPublished = 49;
|
||||
ctnProperty = 50; // child of visibility section or AllClassInterfaces
|
||||
ctnMethodMap = 51; // child of visibility section or AllClassInterfaces
|
||||
|
||||
ctnProcedure = 60; // childs: ctnProcedureHead, sections, ctnBeginBlock/ctnAsmBlock
|
||||
ctnProcedureHead = 61; // childs: ctnParameterList, operator: ctnVarDefinition, operator/function: ctnResultType
|
||||
@ -156,8 +153,10 @@ const
|
||||
+ [ctnInterface, ctnImplementation, ctnInitialization, ctnFinalization];
|
||||
AllClassBaseSections =
|
||||
[ctnClassPublic,ctnClassPublished,ctnClassPrivate,ctnClassProtected];
|
||||
AllClassSubSections =
|
||||
[ctnConstSection, ctnTypeSection, ctnVarSection, ctnClassClassVar];
|
||||
AllClassSections =
|
||||
AllClassBaseSections+[ctnClassConst, ctnClassType, ctnClassVar, ctnClassClassVar];
|
||||
AllClassBaseSections+AllClassSubSections;
|
||||
AllClassInterfaces = [ctnClassInterface,ctnDispinterface,ctnObjCProtocol];
|
||||
AllClassObjects = [ctnClass,ctnObject,ctnRecordType,
|
||||
ctnObjCClass,ctnObjCCategory,ctnCPPClass];
|
||||
@ -350,9 +349,6 @@ begin
|
||||
ctnClassPrivate: Result:='Private';
|
||||
ctnClassProtected: Result:='Protected';
|
||||
ctnClassPublic: Result:='Public';
|
||||
ctnClassConst: Result:='Const';
|
||||
ctnClassType: Result:='Type';
|
||||
ctnClassVar: Result:='Var';
|
||||
ctnClassClassVar: Result:='Class Var';
|
||||
ctnClassAbstract: Result:='abstract';
|
||||
ctnClassSealed: Result:='sealed';
|
||||
|
||||
@ -2180,7 +2180,7 @@ begin
|
||||
end;
|
||||
|
||||
// add class name
|
||||
ClassStr := NewTool.ExtractClassName(NewNode, False);
|
||||
ClassStr := NewTool.ExtractClassName(NewNode, False, true);
|
||||
if ClassStr <> '' then Result := Result + ClassStr + '.';
|
||||
|
||||
Result:=Result+NewTool.ExtractDefinitionName(NewNode);
|
||||
@ -2240,7 +2240,7 @@ begin
|
||||
|
||||
if NewNode.Desc = ctnProperty then
|
||||
begin // add class name
|
||||
ClassStr := NewTool.ExtractClassName(NewNode, False);
|
||||
ClassStr := NewTool.ExtractClassName(NewNode, False, True);
|
||||
if ClassStr <> '' then Result := Result + ClassStr + '.';
|
||||
end;
|
||||
|
||||
@ -2967,7 +2967,7 @@ var
|
||||
ctnLabelSection, ctnPropertySection,
|
||||
ctnInterface, ctnImplementation,
|
||||
ctnClassPublished,ctnClassPublic,ctnClassProtected,ctnClassPrivate,
|
||||
ctnClassConst,ctnClassType,ctnClassVar,ctnClassClassVar,
|
||||
ctnClassClassVar,
|
||||
ctnRecordVariant,
|
||||
ctnProcedureHead, ctnParameterList,
|
||||
ctnClassInheritance:
|
||||
@ -3086,7 +3086,7 @@ begin
|
||||
ctnLabelSection, ctnPropertySection,
|
||||
ctnInterface, ctnImplementation,
|
||||
ctnClassPublic, ctnClassPrivate, ctnClassProtected, ctnClassPublished,
|
||||
ctnClassConst, ctnClassType, ctnClassVar, ctnClassClassVar,
|
||||
ctnClassClassVar,
|
||||
ctnClass, ctnClassInterface, ctnDispinterface, ctnObject,
|
||||
ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass,
|
||||
ctnRecordType, ctnRecordVariant,
|
||||
|
||||
@ -402,7 +402,7 @@ begin
|
||||
// gather the method bodies
|
||||
SearchInNodes:=GatherProcNodes(TypeSectionNode,
|
||||
[phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname],
|
||||
ExtractClassName(ClassNode,true));
|
||||
ExtractClassName(ClassNode,true,true));
|
||||
try
|
||||
// remove all corresponding methods
|
||||
RemoveCorrespondingProcNodes(SearchInNodes,SearchForNodes,false);
|
||||
@ -524,20 +524,19 @@ begin
|
||||
end else begin
|
||||
// procedure is not forward, search on same proc level
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint 4A');
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint proc body');
|
||||
{$ENDIF}
|
||||
SearchedClassname:=ExtractClassNameOfProcNode(ProcNode);
|
||||
SearchedClassname:=ExtractClassNameOfProcNode(ProcNode,true);
|
||||
StartNode:=FindFirstNodeOnSameLvl(ProcNode);
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint 4B ',dbgs(StartNode<>nil),' ',SearchedClassName);
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint body to decl: ',dbgs(StartNode<>nil),' Class="',SearchedClassName,'"');
|
||||
{$ENDIF}
|
||||
if StartNode=nil then exit;
|
||||
if SearchedClassname<>'' then begin
|
||||
// search class node
|
||||
ClassNode:=FindClassNode(StartNode,UpperCaseStr(SearchedClassName),
|
||||
true,false);
|
||||
ClassNode:=FindClassNode(StartNode,SearchedClassName,true,false);
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint 4C ',dbgs(ClassNode<>nil));
|
||||
DebugLn('TMethodJumpingCodeTool.FindJumpPoint class found: ',dbgs(ClassNode<>nil));
|
||||
{$ENDIF}
|
||||
if ClassNode=nil then exit;
|
||||
// search first class grand child node
|
||||
@ -567,7 +566,7 @@ begin
|
||||
TypeSectionNode:=ClassNode.GetTopMostNodeOfType(ctnTypeSection);
|
||||
SearchForNodes:=GatherProcNodes(TypeSectionNode,
|
||||
[phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname],
|
||||
ExtractClassName(ClassNode,true));
|
||||
ExtractClassName(ClassNode,true,true));
|
||||
try
|
||||
// remove corresponding methods
|
||||
RemoveCorrespondingProcNodes(SearchForNodes,SearchInNodes,false);
|
||||
@ -786,7 +785,7 @@ begin
|
||||
//DebugLn('[TMethodJumpingCodeTool.GatherProcNodes] B');
|
||||
cmp:=true;
|
||||
if (phpOnlyWithClassname in Attr) then begin
|
||||
CurClassName:=ExtractClassNameOfProcNode(ANode);
|
||||
CurClassName:=ExtractClassNameOfProcNode(ANode,true);
|
||||
//DebugLn('[TMethodJumpingCodeTool.GatherProcNodes] B2 "',CurClassName,'" =? ',UpperClassName);
|
||||
|
||||
if CompareIdentifiers(PChar(UpperClassName),PChar(CurClassName))<>0 then
|
||||
@ -795,7 +794,7 @@ begin
|
||||
if cmp and (phpIgnoreMethods in Attr) then begin
|
||||
if (ANode.GetNodeOfTypes([ctnClass,ctnObject,ctnRecordType,
|
||||
ctnObjCClass,ctnObjCCategory,ctnCPPClass])<>nil)
|
||||
or (ExtractClassNameOfProcNode(ANode)<>'')
|
||||
or (ExtractClassNameOfProcNode(ANode,true)<>'')
|
||||
then
|
||||
cmp:=false;
|
||||
end;
|
||||
|
||||
@ -167,20 +167,10 @@ type
|
||||
function KeyWordFuncClassMethod: boolean;
|
||||
function KeyWordFuncClassProperty: boolean;
|
||||
function KeyWordFuncClassIdentifier: boolean;
|
||||
function KeyWordFuncClassVarTypeClass: boolean;
|
||||
function KeyWordFuncClassVarTypePacked: boolean;
|
||||
function KeyWordFuncClassVarTypeBitPacked: boolean;
|
||||
function KeyWordFuncClassVarTypeRecord: boolean;
|
||||
function KeyWordFuncClassVarTypeArray: boolean;
|
||||
function KeyWordFuncClassVarTypeSet: boolean;
|
||||
function KeyWordFuncClassVarTypeProc: boolean;
|
||||
function KeyWordFuncClassVarTypeIdent: boolean;
|
||||
// keyword lists
|
||||
procedure BuildDefaultKeyWordFunctions; override;
|
||||
function ParseType(StartPos, WordLen: integer): boolean;
|
||||
function ParseInnerClass(StartPos, WordLen: integer): boolean;
|
||||
function ParseClassVarType(StartPos, WordLen: integer): boolean;
|
||||
function SkipInnerClassInterface(StartPos, WordLen: integer): boolean;
|
||||
function UnexpectedKeyWord: boolean;
|
||||
function EndOfSourceExpected: boolean;
|
||||
// read functions
|
||||
@ -496,65 +486,6 @@ begin
|
||||
Result:=KeyWordFuncClassIdentifier;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.ParseClassVarType(StartPos, WordLen: integer
|
||||
): boolean;
|
||||
// KeywordFunctions for parsing the type of a variable in a class/object
|
||||
var
|
||||
p: PChar;
|
||||
begin
|
||||
if StartPos>SrcLen then exit(false);
|
||||
p:=@Src[StartPos];
|
||||
case UpChars[p^] of
|
||||
'A':
|
||||
if CompareSrcIdentifiers('ARRAY',p) then exit(KeyWordFuncClassVarTypeArray);
|
||||
'B':
|
||||
if CompareSrcIdentifiers('BITPACKED',p) then exit(KeyWordFuncClassVarTypeBitPacked);
|
||||
'C':
|
||||
if CompareSrcIdentifiers('CLASS',p) then exit(KeyWordFuncClassVarTypeClass);
|
||||
'F':
|
||||
if CompareSrcIdentifiers('FUNCTION',p) then exit(KeyWordFuncClassVarTypeProc);
|
||||
'O':
|
||||
if CompareSrcIdentifiers('OBJECT',p) then exit(KeyWordFuncClassVarTypeClass);
|
||||
'P':
|
||||
case UpChars[p[1]] of
|
||||
'A': if CompareSrcIdentifiers('PACKED',p) then exit(KeyWordFuncClassVarTypePacked);
|
||||
'R': if CompareSrcIdentifiers('PROCEDURE',p) then exit(KeyWordFuncClassVarTypeProc);
|
||||
end;
|
||||
'R':
|
||||
if CompareSrcIdentifiers('RECORD',p) then exit(KeyWordFuncClassVarTypeRecord);
|
||||
'S':
|
||||
if CompareSrcIdentifiers('SET',p) then exit(KeyWordFuncClassVarTypeSet);
|
||||
end;
|
||||
Result:=KeyWordFuncClassVarTypeIdent;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.SkipInnerClassInterface(StartPos, WordLen: integer
|
||||
): boolean;
|
||||
// KeyWordFunctions for skipping in a class interface, dispinterface
|
||||
var
|
||||
p: PChar;
|
||||
begin
|
||||
if StartPos>SrcLen then exit(false);
|
||||
p:=@Src[StartPos];
|
||||
case UpChars[p^] of
|
||||
'E': if CompareSrcIdentifiers(p,'END') then exit(false);
|
||||
'F': if CompareSrcIdentifiers(p,'FUNCTION') then exit(KeyWordFuncClassMethod);
|
||||
'P':
|
||||
if (UpChars[p[1]]='R') and (UpChars[p[2]]='O') then
|
||||
case UpChars[p[3]] of
|
||||
'C': if CompareSrcIdentifiers(p,'PROCEDURE') then exit(KeyWordFuncClassMethod);
|
||||
'P': if CompareSrcIdentifiers(p,'PROPERTY') then exit(KeyWordFuncClassProperty);
|
||||
end;
|
||||
'(','[':
|
||||
begin
|
||||
ReadTilBracketClose(true);
|
||||
exit(true);
|
||||
end;
|
||||
';': exit(true);
|
||||
end;
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.UnexpectedKeyWord: boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
@ -804,7 +735,7 @@ function TPascalParserTool.KeyWordFuncClassIdentifier: boolean;
|
||||
TCompareFunc = function(const Item1, Item2: T): Integer;
|
||||
}
|
||||
begin
|
||||
if CurNode.Desc = ctnClassType then begin
|
||||
if CurNode.Desc = ctnTypeSection then begin
|
||||
// create type definition node
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnTypeDefinition;
|
||||
@ -812,7 +743,7 @@ begin
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
end else
|
||||
if CurNode.Desc = ctnClassConst then begin
|
||||
if CurNode.Desc = ctnConstSection then begin
|
||||
// create const definition node
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnConstDefinition;
|
||||
@ -844,151 +775,15 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassVarTypeClass: boolean;
|
||||
// class and object as type are not allowed, because they would have no name
|
||||
begin
|
||||
SaveRaiseExceptionFmt(ctsAnonymDefinitionsAreNotAllowed,[GetAtom]);
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassVarTypePacked: boolean;
|
||||
// 'packed' record
|
||||
begin
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('RECORD') then
|
||||
Result:=KeyWordFuncClassVarTypeRecord
|
||||
else begin
|
||||
RaiseStringExpectedButAtomFound('"record"');
|
||||
Result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassVarTypeBitPacked: boolean;
|
||||
// 'bitpacked' array
|
||||
begin
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('ARRAY') then
|
||||
Result:=KeyWordFuncClassVarTypeArray
|
||||
else begin
|
||||
RaiseStringExpectedButAtomFound('"array"');
|
||||
Result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassVarTypeRecord: boolean;
|
||||
{ read variable type 'record'
|
||||
|
||||
examples:
|
||||
record
|
||||
i: packed record
|
||||
j: integer;
|
||||
k: record end;
|
||||
case integer of
|
||||
0: (a: integer);
|
||||
1,2,3: (b: array[char] of char; c: char);
|
||||
3: ( d: record
|
||||
case byte of
|
||||
10: (i: integer; );
|
||||
11: (y: byte);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
}
|
||||
var Level: integer;
|
||||
begin
|
||||
Level:=1;
|
||||
while (CurPos.StartPos<=SrcLen) and (Level>0) do begin
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('RECORD') then inc(Level)
|
||||
else if (CurPos.Flag=cafEND) then dec(Level);
|
||||
end;
|
||||
if CurPos.StartPos>SrcLen then
|
||||
SaveRaiseException(ctsEndForRecordNotFound);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassVarTypeArray: boolean;
|
||||
{ read variable type 'array'
|
||||
|
||||
examples:
|
||||
array of array[EnumType] of array [Range] of TypeName;
|
||||
}
|
||||
begin
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag=cafEdgedBracketOpen then begin
|
||||
// array[Range]
|
||||
ReadTilBracketClose(true);
|
||||
ReadNextAtom;
|
||||
end;
|
||||
if not UpAtomIs('OF') then
|
||||
RaiseCharExpectedButAtomFound('[');
|
||||
ReadNextAtom;
|
||||
Result:=ParseClassVarType(CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassVarTypeSet: boolean;
|
||||
{ read variable type 'set of'
|
||||
|
||||
examples:
|
||||
set of Name
|
||||
set of (MyEnummy4 := 4 , MyEnummy5);
|
||||
}
|
||||
begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnSetType;
|
||||
ReadNextAtom;
|
||||
if not UpAtomIs('OF') then
|
||||
RaiseStringExpectedButAtomFound('"of"');
|
||||
ReadNextAtom;
|
||||
if CurPos.StartPos>SrcLen then
|
||||
SaveRaiseException(ctsMissingEnumList);
|
||||
if IsIdentStartChar[Src[CurPos.StartPos]] then
|
||||
// set of identifier
|
||||
else if CurPos.Flag=cafRoundBracketOpen then
|
||||
// set of ()
|
||||
ReadTilBracketClose(true);
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassVarTypeProc: boolean;
|
||||
{ read variable type 'procedure ...' or 'function ... : ...'
|
||||
|
||||
examples:
|
||||
procedure
|
||||
function : integer;
|
||||
procedure (a: char) of object;
|
||||
}
|
||||
var IsFunction, HasForwardModifier: boolean;
|
||||
ParseAttr: TParseProcHeadAttributes;
|
||||
begin
|
||||
//DebugLn('[TPascalParserTool.KeyWordFuncClassVarTypeProc]');
|
||||
IsFunction:=UpAtomIs('FUNCTION');
|
||||
ReadNextAtom;
|
||||
HasForwardModifier:=false;
|
||||
ParseAttr:=[pphIsMethod,pphIsType];
|
||||
if IsFunction then Include(ParseAttr,pphIsFunction);
|
||||
ReadTilProcedureHeadEnd(ParseAttr,HasForwardModifier);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassVarTypeIdent: boolean;
|
||||
// read variable type <identifier>
|
||||
begin
|
||||
if CurPos.StartPos>SrcLen then
|
||||
SaveRaiseException(ctsMissingTypeIdentifier);
|
||||
if IsIdentStartChar[Src[CurPos.StartPos]] then
|
||||
// identifier
|
||||
else
|
||||
SaveRaiseException(ctsMissingTypeIdentifier);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassSection: boolean;
|
||||
// change section in a class (public, private, protected, published)
|
||||
begin
|
||||
// end last section
|
||||
if CurNode.Desc in AllClassSubSections then begin
|
||||
// end sub section
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
// end last visibility section
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
// start new section
|
||||
@ -1009,23 +804,27 @@ end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassConstSection: boolean;
|
||||
begin
|
||||
// end last section
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
if CurNode.Desc in AllClassSubSections then begin
|
||||
// end last sub section
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
// start new section
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnClassConst;
|
||||
CurNode.Desc:=ctnConstSection;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.KeyWordFuncClassTypeSection: boolean;
|
||||
begin
|
||||
// end last section
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
if CurNode.Desc in AllClassSubSections then begin
|
||||
// end last sub section
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
// start new section
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnClassType;
|
||||
CurNode.Desc:=ctnTypeSection;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
@ -1035,9 +834,11 @@ function TPascalParserTool.KeyWordFuncClassVarSection: boolean;
|
||||
class var
|
||||
}
|
||||
begin
|
||||
// end last section
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
if CurNode.Desc in AllClassSubSections then begin
|
||||
// end last sub section
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
// start new section
|
||||
CreateChildNode;
|
||||
if UpAtomIs('CLASS') then
|
||||
@ -1046,7 +847,7 @@ begin
|
||||
ReadNextAtom;
|
||||
end
|
||||
else
|
||||
CurNode.Desc:=ctnClassVar;
|
||||
CurNode.Desc:=ctnVarSection;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
@ -1100,7 +901,11 @@ function TPascalParserTool.KeyWordFuncClassMethod: boolean;
|
||||
var IsFunction, HasForwardModifier: boolean;
|
||||
ParseAttr: TParseProcHeadAttributes;
|
||||
begin
|
||||
if not (CurNode.Desc in (AllClassSections+AllClassInterfaces)) then
|
||||
if (CurNode.Desc in AllClassSubSections)
|
||||
and (CurNode.Parent.Desc in AllClassBaseSections) then begin
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
end else if not (CurNode.Desc in (AllClassBaseSections+AllClassInterfaces)) then
|
||||
RaiseIdentExpectedButAtomFound;
|
||||
|
||||
HasForwardModifier:=false;
|
||||
@ -2210,7 +2015,11 @@ function TPascalParserTool.KeyWordFuncClassProperty: boolean;
|
||||
end;
|
||||
|
||||
begin
|
||||
if not (CurNode.Desc in (AllClassBaseSections+AllClassInterfaces)) then
|
||||
if (CurNode.Desc in AllClassSubSections)
|
||||
and (CurNode.Parent.Desc in AllClassBaseSections) then begin
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
end else if not (CurNode.Desc in (AllClassBaseSections+AllClassInterfaces)) then
|
||||
RaiseIdentExpectedButAtomFound;
|
||||
// create class method node
|
||||
CreateChildNode;
|
||||
@ -2457,11 +2266,13 @@ begin
|
||||
CurNode.SubDesc:=ctnsNeedJITParsing;
|
||||
end;
|
||||
ReadNextAtom;
|
||||
if (CurSection<>ctnInterface) and (CurPos.Flag=cafPoint) then begin
|
||||
// read procedure name of a class method (the name after the . )
|
||||
ReadNextAtom;
|
||||
AtomIsIdentifier(true);
|
||||
ReadNextAtom;
|
||||
if (CurSection<>ctnInterface) then begin
|
||||
while (CurPos.Flag=cafPoint) do begin
|
||||
// read procedure name of a class method (the name after the . )
|
||||
ReadNextAtom;
|
||||
AtomIsIdentifier(true);
|
||||
ReadNextAtom;
|
||||
end;
|
||||
end;
|
||||
// read rest of procedure head
|
||||
HasForwardModifier:=false;
|
||||
@ -3628,6 +3439,7 @@ var
|
||||
ClassDesc: TCodeTreeNodeDesc;
|
||||
ClassNode: TCodeTreeNode;
|
||||
begin
|
||||
//debugln(['TPascalParserTool.KeyWordFuncTypeClass ',GetAtom,' ',CleanPosToStr(CurPos.StartPos)]);
|
||||
// class or 'class of' start found
|
||||
if UpAtomIs('CLASS') then
|
||||
ClassDesc:=ctnClass
|
||||
@ -3740,6 +3552,11 @@ begin
|
||||
end;
|
||||
ReadNextAtom;
|
||||
until false;
|
||||
// end last sub section
|
||||
if CurNode.Desc in AllClassSubSections then begin
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
// end last class section (public, private, ...)
|
||||
CurNode.EndPos:=CurPos.StartPos;
|
||||
EndChildNode;
|
||||
@ -3776,6 +3593,7 @@ begin
|
||||
// place cursor on atom behind
|
||||
if CurPos.Flag<>cafSemicolon then
|
||||
ReadNextAtom;
|
||||
//debugln(['TPascalParserTool.KeyWordFuncTypeClass END ',GetAtom,' ',CleanPosToStr(CurPos.StartPos)]);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
|
||||
@ -89,7 +89,8 @@ type
|
||||
Attr: TProcHeadAttributes): string;
|
||||
function ExtractProcHead(ProcNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): string;
|
||||
function ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode): string;
|
||||
function ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode;
|
||||
AddParentClasses: boolean = true): string;
|
||||
function ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
|
||||
ProcSpec: TProcedureSpecifier): boolean;
|
||||
function GetProcNameIdentifier(ProcNode: TCodeTreeNode): PChar;
|
||||
@ -125,15 +126,17 @@ type
|
||||
|
||||
// classes
|
||||
function ExtractClassName(ClassNode: TCodeTreeNode;
|
||||
InUpperCase: boolean): string;
|
||||
InUpperCase: boolean; WithParents: boolean = true): string;
|
||||
function ExtractClassInheritance(ClassNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): string;
|
||||
function FindClassNode(StartNode: TCodeTreeNode;
|
||||
const AClassName: string;
|
||||
const AClassName: string; // nested: A.B
|
||||
IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
|
||||
function FindClassNodeBackwards(StartNode: TCodeTreeNode;
|
||||
const AClassName: string;
|
||||
IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
|
||||
function FindNestedClass(RootClassNode: TCodeTreeNode;
|
||||
AClassName: PChar; SkipFirst: boolean): TCodeTreeNode;
|
||||
function FindClassNode(CursorNode: TCodeTreeNode): TCodeTreeNode;
|
||||
function FindClassNodeForMethodBody(ProcNode: TCodeTreeNode;
|
||||
IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
|
||||
@ -180,7 +183,7 @@ type
|
||||
function ExtractArrayRange(ArrayNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): string;
|
||||
|
||||
// sections
|
||||
// module sections
|
||||
function GetSourceName(DoBuildTree: boolean = true): string;
|
||||
function GetSourceType: TCodeTreeNodeDesc;
|
||||
function GetSourceNamePos(var NamePos: TAtomPosition): boolean;
|
||||
@ -341,6 +344,7 @@ function TPascalReaderTool.ExtractProcName(ProcNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): string;
|
||||
var
|
||||
ProcHeadNode: TCodeTreeNode;
|
||||
Part: String;
|
||||
begin
|
||||
Result:='';
|
||||
if [phpWithoutClassName,phpWithoutName]*Attr=
|
||||
@ -353,39 +357,34 @@ begin
|
||||
ProcHeadNode:=ProcNode.FirstChild;
|
||||
if (ProcHeadNode=nil) or (ProcHeadNode.StartPos<1) then exit;
|
||||
MoveCursorToNodeStart(ProcHeadNode);
|
||||
ReadNextAtom;
|
||||
if not AtomIsIdentifier(false) then exit;
|
||||
if phpInUpperCase in Attr then
|
||||
Result:=GetUpAtom
|
||||
else
|
||||
Result:=GetAtom;
|
||||
ReadNextAtom;
|
||||
if (CurPos.Flag=cafPoint) then begin
|
||||
if (phpWithoutClassName in Attr) then begin
|
||||
Result:='';
|
||||
end else begin
|
||||
if not (phpWithoutName in Attr) then
|
||||
Result:=Result+'.';
|
||||
end;
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if not (phpWithoutName in Attr) then begin
|
||||
if phpInUpperCase in Attr then
|
||||
Result:=Result+GetUpAtom
|
||||
else
|
||||
Result:=Result+GetAtom;
|
||||
if not AtomIsIdentifier(false) then exit;
|
||||
if phpInUpperCase in Attr then
|
||||
Part:=GetUpAtom
|
||||
else
|
||||
Part:=GetAtom;
|
||||
ReadNextAtom;
|
||||
if (CurPos.Flag<>cafPoint) then begin
|
||||
// end of method identifier is the proc name
|
||||
if phpWithoutName in Attr then exit;
|
||||
if Result<>'' then Result:=Result+'.';
|
||||
Result:=Result+Part;
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
if phpWithoutName in Attr then
|
||||
Result:='';
|
||||
end;
|
||||
if not (phpWithoutClassName in Attr) then begin
|
||||
// in front of . is class name
|
||||
if Result<>'' then Result:=Result+'.';
|
||||
Result:=Result+Part;
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ExtractProcHead(ProcNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): string;
|
||||
var
|
||||
TypeDefNode: TCodeTreeNode;
|
||||
TheClassName, s: string;
|
||||
HasClassName, IsProcType: boolean;
|
||||
IsClassName, IsProcType: boolean;
|
||||
IsProcedure: Boolean;
|
||||
IsFunction: Boolean;
|
||||
IsOperator: Boolean;
|
||||
@ -402,15 +401,14 @@ begin
|
||||
if (ProcNode.Desc<>ctnProcedure) and (ProcNode.Desc<>ctnProcedureType) then
|
||||
exit;
|
||||
IsProcType:=(ProcNode.Desc=ctnProcedureType);
|
||||
if (phpAddClassname in Attr) then begin
|
||||
TheClassName:='';
|
||||
TypeDefNode:=FindClassOrInterfaceNode(ProcNode);
|
||||
if TypeDefNode<>nil then begin
|
||||
TheClassName:=ExtractClassName(TypeDefNode,phpInUpperCase in Attr);
|
||||
end;
|
||||
end;
|
||||
InitExtraction;
|
||||
|
||||
// build full class name
|
||||
TheClassName:='';
|
||||
if ([phpAddClassname,phpWithoutClassName]*Attr=[phpAddClassName]) then
|
||||
TheClassName:=ExtractClassName(ProcNode,phpInUpperCase in Attr,true);
|
||||
|
||||
// reparse the clean source
|
||||
InitExtraction;
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
// parse procedure head = start + name + parameterlist + result type ;
|
||||
ExtractNextAtom(false,Attr);
|
||||
@ -431,32 +429,41 @@ begin
|
||||
if not IsProcType then begin
|
||||
// read name
|
||||
if (not IsOperator) and (not AtomIsIdentifier(false)) then exit;
|
||||
ReadNextAtom;
|
||||
HasClassName:=(CurPos.Flag=cafPoint);
|
||||
UndoReadNextAtom;
|
||||
if HasClassName then begin
|
||||
// read class name
|
||||
ExtractNextAtom(not (phpWithoutClassName in Attr),Attr);
|
||||
// read '.'
|
||||
ExtractNextAtom(not (phpWithoutClassName in Attr),Attr);
|
||||
// read name
|
||||
if not AtomIsIdentifier(false) then exit;
|
||||
ExtractNextAtom(not (phpWithoutName in Attr),Attr);
|
||||
|
||||
if TheClassName<>'' then begin
|
||||
s:=TheClassName+'.';
|
||||
if phpInUpperCase in Attr then s:=UpperCaseStr(s);
|
||||
if ExtractStreamEndIsIdentChar then
|
||||
s:=' '+s;
|
||||
ExtractMemStream.Write(s[1],length(s));
|
||||
end;
|
||||
|
||||
if [phpWithoutClassName,phpWithoutName]*Attr=[] then begin
|
||||
// read classname and name
|
||||
repeat
|
||||
ExtractNextAtom(true,Attr);
|
||||
if CurPos.Flag<>cafPoint then break;
|
||||
ExtractNextAtom(true,Attr);
|
||||
if not AtomIsIdentifier(false) then exit;
|
||||
until false;
|
||||
end else begin
|
||||
// read name
|
||||
if (not (phpAddClassname in Attr)) or (TheClassName='') then begin
|
||||
ExtractNextAtom(not (phpWithoutName in Attr),Attr);
|
||||
end else begin
|
||||
// add class name
|
||||
s:=TheClassName+'.';
|
||||
if not (phpWithoutName in Attr) then
|
||||
s:=s+GetAtom;
|
||||
ExtractNextAtom(false,Attr);
|
||||
if phpInUpperCase in Attr then s:=UpperCaseStr(s);
|
||||
if ExtractStreamEndIsIdentChar then
|
||||
s:=' '+s;
|
||||
ExtractMemStream.Write(s[1],length(s));
|
||||
end;
|
||||
// read only part of name
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
IsClassName:=(CurPos.Flag=cafPoint);
|
||||
UndoReadNextAtom;
|
||||
if IsClassName then begin
|
||||
// read class name
|
||||
ExtractNextAtom(not (phpWithoutClassName in Attr),Attr);
|
||||
// read '.'
|
||||
ExtractNextAtom(not (phpWithoutClassName in Attr),Attr);
|
||||
if not AtomIsIdentifier(false) then break;
|
||||
end else begin
|
||||
// read name
|
||||
ExtractNextAtom(not (phpWithoutName in Attr),Attr);
|
||||
break;
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
ExtractProcHeadPos:=phepName;
|
||||
end;
|
||||
@ -526,31 +533,23 @@ begin
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ExtractClassName(ClassNode: TCodeTreeNode;
|
||||
InUpperCase: boolean): string;
|
||||
var
|
||||
DefNode: TCodeTreeNode;
|
||||
InUpperCase, WithParents: boolean): string;
|
||||
begin
|
||||
if ClassNode<>nil then begin
|
||||
ClassNode:=FindClassOrInterfaceNode(ClassNode);
|
||||
if (ClassNode = nil) then begin
|
||||
Result := '';
|
||||
Exit;
|
||||
Result:='';
|
||||
while ClassNode<>nil do begin
|
||||
if ClassNode.Desc in [ctnTypeDefinition,ctnGenericType] then begin
|
||||
if Result<>'' then Result:='.'+Result;
|
||||
if ClassNode.Desc=ctnTypeDefinition then
|
||||
Result:=GetIdentifier(@Src[ClassNode.StartPos])+Result
|
||||
else if ClassNode.FirstChild<>nil then
|
||||
Result:=GetIdentifier(@Src[ClassNode.FirstChild.StartPos])+Result;
|
||||
if not WithParents then break;
|
||||
end;
|
||||
ClassNode:=ClassNode.Parent;
|
||||
end;
|
||||
|
||||
DefNode:=ClassNode.Parent;
|
||||
if (DefNode<>nil) and (DefNode.Desc=ctnGenericType) then
|
||||
DefNode:=DefNode.FirstChild;
|
||||
if DefNode=nil then begin
|
||||
Result:='';
|
||||
exit;
|
||||
end;
|
||||
|
||||
if InUpperCase then
|
||||
Result:=UpperCaseStr(GetIdentifier(@Src[DefNode.StartPos]))
|
||||
else
|
||||
Result:=GetIdentifier(@Src[DefNode.StartPos]);
|
||||
end else
|
||||
Result:='';
|
||||
if InUpperCase then
|
||||
Result:=UpperCaseStr(Result);
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ExtractClassInheritance(
|
||||
@ -582,23 +581,29 @@ begin
|
||||
Result:=GetExtraction(phpInUpperCase in Attr);
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode
|
||||
): string;
|
||||
var TheClassName: string;
|
||||
function TPascalReaderTool.ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode;
|
||||
AddParentClasses: boolean): string;
|
||||
var
|
||||
Part: String;
|
||||
begin
|
||||
Result:='';
|
||||
if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure) then
|
||||
ProcNode:=ProcNode.FirstChild;
|
||||
if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureHead) then exit;
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
ReadNextAtom;
|
||||
if not AtomIsIdentifier(false) then exit;
|
||||
TheClassName:=GetAtom;
|
||||
ReadNextAtom;
|
||||
if (CurPos.Flag<>cafPoint) then exit;
|
||||
ReadNextAtom;
|
||||
if not AtomIsIdentifier(false) then exit;
|
||||
Result:=TheClassName;
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if not AtomIsIdentifier(false) then break;
|
||||
Part:=GetAtom;
|
||||
ReadNextAtom;
|
||||
if (CurPos.Flag<>cafPoint) then break;
|
||||
if Result<>'' then Result:=Result+'.';
|
||||
Result:=Result+Part;
|
||||
until false;
|
||||
if not AddParentClasses then exit;
|
||||
Part:=ExtractClassName(ProcNode,false,true);
|
||||
if Part='' then exit;
|
||||
Result:=Part+'.'+Result;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.FindProcNode(StartNode: TCodeTreeNode;
|
||||
@ -658,8 +663,8 @@ begin
|
||||
end else if NodeIsMethodBody(ProcNode) then begin
|
||||
//debugln('TPascalReaderTool.FindCorrespondingProcNode Method ',ExtractClassNameOfProcNode(ProcNode));
|
||||
// in a method body -> search in class
|
||||
StartNode:=FindClassNodeInUnit(ExtractClassNameOfProcNode(ProcNode),true,
|
||||
false,false,true);
|
||||
StartNode:=FindClassNodeInUnit(ExtractClassNameOfProcNode(ProcNode,true),
|
||||
true,false,false,true);
|
||||
if StartNode=nil then exit;
|
||||
if (StartNode<>nil) and (StartNode.Desc in AllClasses)
|
||||
then begin
|
||||
@ -866,50 +871,43 @@ begin
|
||||
if UpAtomIs('CLASS') then ReadNextAtom;
|
||||
ReadNextAtom; // skip proc keyword
|
||||
end;
|
||||
if SkipClassName then begin
|
||||
if not SkipClassName then exit;
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag=cafPoint then
|
||||
ReadNextAtom
|
||||
else
|
||||
if CurPos.Flag<>cafPoint then begin
|
||||
UndoReadNextAtom;
|
||||
end;
|
||||
break;
|
||||
end;
|
||||
ReadNextAtom;
|
||||
until not AtomIsIdentifier(false);
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.PositionInProcName(ProcNode: TCodeTreeNode;
|
||||
SkipClassName: boolean; CleanPos: integer): boolean;
|
||||
var
|
||||
InFirstAtom: Boolean;
|
||||
begin
|
||||
if (ProcNode.Desc=ctnProcedure) and (ProcNode.FirstChild<>nil)
|
||||
and (ProcNode.FirstChild.Desc=ctnProcedureHead) then
|
||||
ProcNode:=ProcNode.FirstChild;
|
||||
if (CleanPos<ProcNode.StartPos) or (CleanPos>ProcNode.EndPos) then exit(false);
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
ReadNextAtom;
|
||||
if (ProcNode.Desc=ctnProcedure) then begin
|
||||
if UpAtomIs('CLASS') then ReadNextAtom;
|
||||
ReadNextAtom; // skip proc keyword
|
||||
end;
|
||||
if CurPos.Flag<>cafWord then exit(false);
|
||||
// now CurPos is either the classname or the procname
|
||||
InFirstAtom:=(CleanPos>=CurPos.StartPos) and (CleanPos<=CurPos.EndPos);
|
||||
ReadNextAtom;
|
||||
// read point
|
||||
if CurPos.Flag<>cafPoint then begin
|
||||
// procname without classname
|
||||
exit(InFirstAtom);
|
||||
if CleanPos<CurPos.StartPos then exit(false);
|
||||
while CurPos.Flag=cafWord do begin
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag<>cafPoint then begin
|
||||
UndoReadNextAtom;
|
||||
break;
|
||||
end;
|
||||
ReadNextAtom;
|
||||
end;
|
||||
// there is a classname
|
||||
if (CleanPos>=CurPos.StartPos) and (CleanPos<=CurPos.EndPos)
|
||||
and (not SkipClassName) then
|
||||
exit(true); // position at point
|
||||
// now read the procname
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag<>cafWord then exit(false); // no valid procname
|
||||
if (CleanPos>=CurPos.StartPos) and (CleanPos<=CurPos.EndPos) then
|
||||
exit(true); // position at procname
|
||||
if (not SkipClassName) and InFirstAtom then
|
||||
exit(true); // position at classname
|
||||
Result:=false;
|
||||
// CurPos is now on the proc name
|
||||
if CleanPos>CurPos.EndPos then exit(false);
|
||||
if SkipClassName and (CleanPos<CurPos.StartPos) then exit(false);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.PositionInFuncResultName(ProcNode: TCodeTreeNode;
|
||||
@ -938,14 +936,10 @@ begin
|
||||
end else begin
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
ReadNextAtom;
|
||||
if AtomIsIdentifier(false) then begin
|
||||
// read name
|
||||
while AtomIsIdentifier(false) do begin
|
||||
ReadNextAtom;
|
||||
if (CurPos.Flag<>cafPoint) then break;
|
||||
ReadNextAtom;
|
||||
if (CurPos.Flag=cafPoint) then begin
|
||||
// read method name
|
||||
ReadNextAtom;
|
||||
ReadNextAtom;
|
||||
end;
|
||||
end;
|
||||
if CurPos.Flag=cafRoundBracketOpen then
|
||||
if not ReadTilBracketClose(false) then exit;
|
||||
@ -1023,13 +1017,12 @@ begin
|
||||
if ProcNode=nil then exit;
|
||||
end;
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
ReadNextAtom;
|
||||
if not AtomIsIdentifier(false) then exit;
|
||||
Result:=@Src[CurPos.StartPos];
|
||||
ReadNextAtom;
|
||||
if not AtomIsChar('.') then exit;
|
||||
ReadNextAtom;
|
||||
Result:=@Src[CurPos.StartPos];
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if not AtomIsIdentifier(false) then exit(nil);
|
||||
Result:=@Src[CurPos.StartPos];
|
||||
ReadNextAtom;
|
||||
until CurPos.Flag<>cafPoint;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ExtractNode(ANode: TCodeTreeNode;
|
||||
@ -1372,14 +1365,15 @@ end;
|
||||
function TPascalReaderTool.FindClassNode(StartNode: TCodeTreeNode;
|
||||
const AClassName: string; IgnoreForwards, IgnoreNonForwards: boolean
|
||||
): TCodeTreeNode;
|
||||
// search for types on same level,
|
||||
// with type class and classname = SearchedClassName
|
||||
// search for class like types on same level
|
||||
var
|
||||
ANode, CurClassNode: TCodeTreeNode;
|
||||
NameNode: TCodeTreeNode;
|
||||
p: PChar;
|
||||
begin
|
||||
ANode:=StartNode;
|
||||
Result:=nil;
|
||||
p:=PChar(AClassName);
|
||||
while (ANode<>nil) do begin
|
||||
if ANode.Desc in [ctnTypeDefinition,ctnGenericType] then begin
|
||||
CurClassNode:=FindTypeNodeOfDefinition(ANode);
|
||||
@ -1393,10 +1387,8 @@ begin
|
||||
NameNode:=ANode;
|
||||
if ANode.Desc=ctnGenericType then
|
||||
NameNode:=ANode.FirstChild;
|
||||
if CompareIdentifiers(PChar(Pointer(AClassName)),
|
||||
@Src[NameNode.StartPos])=0
|
||||
then begin
|
||||
Result:=CurClassNode;
|
||||
if CompareIdentifiers(p,@Src[NameNode.StartPos])=0 then begin
|
||||
Result:=FindNestedClass(CurClassNode,p,true);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@ -1429,8 +1421,10 @@ function TPascalReaderTool.FindClassNodeBackwards(StartNode: TCodeTreeNode;
|
||||
var
|
||||
ANode: TCodeTreeNode;
|
||||
CurClassNode: TCodeTreeNode;
|
||||
p: PChar;
|
||||
begin
|
||||
ANode:=StartNode;
|
||||
p:=PChar(AClassName);
|
||||
while ANode<>nil do begin
|
||||
if ANode.Desc=ctnTypeDefinition then begin
|
||||
CurClassNode:=ANode.FirstChild;
|
||||
@ -1441,10 +1435,8 @@ begin
|
||||
and (not (IgnoreNonForwards
|
||||
and ((CurClassNode.SubDesc and ctnsForwardDeclaration)=0)))
|
||||
then begin
|
||||
if CompareIdentifiers(PChar(Pointer(AClassName)),
|
||||
@Src[ANode.StartPos])=0
|
||||
then begin
|
||||
Result:=CurClassNode;
|
||||
if CompareIdentifiers(p,@Src[ANode.StartPos])=0 then begin
|
||||
Result:=FindNestedClass(CurClassNode,p,true);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@ -1463,6 +1455,53 @@ begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.FindNestedClass(RootClassNode: TCodeTreeNode;
|
||||
AClassName: PChar; SkipFirst: boolean): TCodeTreeNode;
|
||||
var
|
||||
p: PChar;
|
||||
Node: TCodeTreeNode;
|
||||
EndNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=nil;
|
||||
if RootClassNode=nil then exit;
|
||||
if AClassName=nil then exit;
|
||||
p:=AClassName;
|
||||
if SkipFirst then begin
|
||||
while IsIdentChar[p^] do inc(p);
|
||||
if p^=#0 then exit(RootClassNode);
|
||||
if p^<>'.' then exit;
|
||||
inc(p);
|
||||
end;
|
||||
//debugln(['TPascalReaderTool.FindNestedClass p="',p,'"']);
|
||||
if not IsIdentStartChar[p^] then exit;
|
||||
EndNode:=RootClassNode.NextSkipChilds;
|
||||
Node:=RootClassNode.Next;
|
||||
while Node<>EndNode do begin
|
||||
// debugln(['TPascalReaderTool.FindNestedClass Node=',node.DescAsString]);
|
||||
if Node.Desc in [ctnTypeDefinition,ctnGenericType] then begin
|
||||
if (Node.LastChild<>nil) and (Node.LastChild.Desc in AllClasses) then begin
|
||||
if ((Node.Desc=ctnTypeDefinition)
|
||||
and (CompareIdentifierPtrs(p,@Src[Node.StartPos])=0))
|
||||
or ((Node.FirstChild.Desc=ctnGenericName)
|
||||
and (CompareIdentifierPtrs(p,@Src[Node.FirstChild.StartPos])=0))
|
||||
then begin
|
||||
// class found
|
||||
Node:=Node.LastChild;
|
||||
while IsIdentChar[p^] do inc(p);
|
||||
if p^=#0 then exit(Node);
|
||||
if p^<>'.' then exit;
|
||||
Result:=FindNestedClass(Node,p+1,false);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if Node.Desc in AllClassSections then
|
||||
Node:=Node.Next
|
||||
else
|
||||
Node:=Node.NextSkipChilds;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.FindClassNode(CursorNode: TCodeTreeNode
|
||||
): TCodeTreeNode;
|
||||
begin
|
||||
@ -1485,7 +1524,7 @@ var
|
||||
ProcClassName: String;
|
||||
begin
|
||||
Result:=nil;
|
||||
ProcClassName:=ExtractClassNameOfProcNode(ProcNode);
|
||||
ProcClassName:=ExtractClassNameOfProcNode(ProcNode,true);
|
||||
if ProcClassName='' then exit;
|
||||
Result:=FindClassNodeBackwards(ProcNode,ProcClassName,IgnoreForwards,
|
||||
IgnoreNonForwards);
|
||||
@ -1757,7 +1796,10 @@ begin
|
||||
if ProcNode.Desc=ctnProcedureHead then
|
||||
ProcNode:=ProcNode.Parent;
|
||||
if ProcNode.Desc<>ctnProcedure then exit;
|
||||
Result:=CompareIdentifiers('operator',@Src[ProcNode.StartPos])=0;
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('CLASS') then ReadNextAtom;
|
||||
Result:=UpAtomIs('OPERATOR');
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.NodeIsResultIdentifier(Node: TCodeTreeNode
|
||||
@ -2161,12 +2203,12 @@ begin
|
||||
ProcNode:=ProcNode.FirstChild;
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
ReadNextAtom; // read name
|
||||
ReadNextAtom;
|
||||
if AtomIsChar('.') then begin
|
||||
while CurPos.Flag=cafWord do begin
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag<>cafPoint then break;
|
||||
ReadNextAtom;
|
||||
end;
|
||||
Result:=AtomIsChar('(');
|
||||
Result:=CurPos.Flag=cafRoundBracketOpen;
|
||||
end;
|
||||
|
||||
procedure TPascalReaderTool.MoveCursorToUsesStart(UsesNode: TCodeTreeNode);
|
||||
|
||||
@ -2321,12 +2321,12 @@ var
|
||||
if (IdentContext.Node<>nil) and IdentifierNotPublished then begin
|
||||
LFMTree.AddError(lfmeIdentifierNotPublished,LFMNode,
|
||||
'identifier '+IdentName+' is not published in class '
|
||||
+'"'+ClassContext.Tool.ExtractClassName(ClassContext.Node,false)+'"',
|
||||
+'"'+ClassContext.Tool.ExtractClassName(ClassContext.Node,false,true)+'"',
|
||||
DefaultErrorPosition);
|
||||
end else begin
|
||||
LFMTree.AddError(lfmeIdentifierNotFound,LFMNode,
|
||||
'identifier '+IdentName+' not found in class '
|
||||
+'"'+ClassContext.Tool.ExtractClassName(ClassContext.Node,false)+'"',
|
||||
+'"'+ClassContext.Tool.ExtractClassName(ClassContext.Node,false,true)+'"',
|
||||
DefaultErrorPosition);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1105,7 +1105,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
ctnClassConst..ctnClassPublished:
|
||||
ctnClassClassVar..ctnClassPublished:
|
||||
begin
|
||||
if (cefcUnsortedClassVisibility in ObserverCats)
|
||||
and (CodeNode.PriorBrother<>nil)
|
||||
@ -2212,24 +2212,25 @@ const
|
||||
ctnTypeSection,
|
||||
ctnTypeDefinition,ctnGenericType:
|
||||
Result:=1;
|
||||
ctnVarSection,ctnConstSection,ctnResStrSection,ctnLabelSection,
|
||||
ctnVarDefinition,ctnConstDefinition,ctnProperty:
|
||||
ctnConstSection,ctnConstDefinition:
|
||||
Result:=2;
|
||||
ctnVarSection,ctnClassClassVar,ctnResStrSection,ctnLabelSection,
|
||||
ctnVarDefinition:
|
||||
Result:=3;
|
||||
ctnInterface,ctnImplementation,ctnProgram,ctnPackage,ctnLibrary,
|
||||
ctnProcedure:
|
||||
Result:=3;
|
||||
ctnUsesSection:
|
||||
Result:=4;
|
||||
ctnProperty:
|
||||
Result:=5;
|
||||
ctnUsesSection:
|
||||
Result:=6;
|
||||
|
||||
// class sections
|
||||
ctnClassConst,
|
||||
ctnClassType,
|
||||
ctnClassVar,
|
||||
ctnClassClassVar,
|
||||
ctnClassGUID,
|
||||
ctnClassPrivate,
|
||||
ctnClassProtected,
|
||||
ctnClassPublic,
|
||||
ctnClassPublished : Result:=Desc-ctnClassConst;
|
||||
ctnClassPublished : Result:=Desc-ctnClassGUID;
|
||||
|
||||
else Result:=10000;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user