mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-25 23:59:20 +02:00
codetools: parse param list
git-svn-id: trunk@30584 -
This commit is contained in:
parent
1785aedd19
commit
005d8e828c
@ -53,6 +53,9 @@ function FindCommentEnd(const ASource: string; StartPos: integer;
|
|||||||
function IsCommentEnd(const ASource: string; EndPos: integer): boolean;
|
function IsCommentEnd(const ASource: string; EndPos: integer): boolean;
|
||||||
function FindNextComment(const ASource: string;
|
function FindNextComment(const ASource: string;
|
||||||
StartPos: integer; MaxPos: integer = 0): integer;
|
StartPos: integer; MaxPos: integer = 0): integer;
|
||||||
|
procedure FindCommentsInRange(const Src: string; StartPos, EndPos: integer;
|
||||||
|
out FirstCommentStart, FirstAtomStart, LastCommentEnd, LastAtomEnd: integer;
|
||||||
|
NestedComments: boolean = false);
|
||||||
function FindNextCompilerDirective(const ASource: string; StartPos: integer;
|
function FindNextCompilerDirective(const ASource: string; StartPos: integer;
|
||||||
NestedComments: boolean): integer;
|
NestedComments: boolean): integer;
|
||||||
function FindNextCompilerDirectiveWithName(const ASource: string;
|
function FindNextCompilerDirectiveWithName(const ASource: string;
|
||||||
@ -1176,6 +1179,50 @@ begin
|
|||||||
if Result>MaxPos+1 then Result:=MaxPos+1;
|
if Result>MaxPos+1 then Result:=MaxPos+1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure FindCommentsInRange(const Src: string; StartPos, EndPos: integer;
|
||||||
|
out FirstCommentStart, FirstAtomStart, LastCommentEnd, LastAtomEnd: integer;
|
||||||
|
NestedComments: boolean);
|
||||||
|
var
|
||||||
|
p: PChar;
|
||||||
|
i: integer;
|
||||||
|
AtomStart: integer;
|
||||||
|
SrcLen: Integer;
|
||||||
|
begin
|
||||||
|
FirstCommentStart:=0;
|
||||||
|
FirstAtomStart:=0;
|
||||||
|
LastCommentEnd:=0;
|
||||||
|
LastAtomEnd:=0;
|
||||||
|
SrcLen:=length(Src);
|
||||||
|
if (StartPos<1) then StartPos:=1;
|
||||||
|
if StartPos>SrcLen then exit;
|
||||||
|
if EndPos>SrcLen then EndPos:=SrcLen+1;
|
||||||
|
i:=StartPos;
|
||||||
|
while i<EndPos do begin
|
||||||
|
p:=@Src[i];
|
||||||
|
// skip space
|
||||||
|
while IsSpaceChar[p^] do inc(p);
|
||||||
|
i:=p-PChar(Src)+1;
|
||||||
|
if i>=EndPos then exit;
|
||||||
|
|
||||||
|
if (p^='{') or ((p^='(') and (p[1]='*')) or ((p^='/') and (p[1]='/')) then
|
||||||
|
begin
|
||||||
|
// a comment
|
||||||
|
if FirstCommentStart=0 then
|
||||||
|
FirstCommentStart:=i;
|
||||||
|
i:=FindCommentEnd(Src,i,NestedComments);
|
||||||
|
if LastCommentEnd=0 then
|
||||||
|
LastCommentEnd:=i;
|
||||||
|
end else begin
|
||||||
|
// normal atom
|
||||||
|
if FirstAtomStart=0 then
|
||||||
|
FirstAtomStart:=i;
|
||||||
|
ReadRawNextPascalAtom(Src,i,AtomStart);
|
||||||
|
if LastAtomEnd=0 then
|
||||||
|
LastAtomEnd:=i;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
function FindNextCompilerDirective(const ASource: string; StartPos: integer;
|
function FindNextCompilerDirective(const ASource: string; StartPos: integer;
|
||||||
NestedComments: boolean): integer;
|
NestedComments: boolean): integer;
|
||||||
var
|
var
|
||||||
@ -1288,7 +1335,7 @@ end;
|
|||||||
|
|
||||||
function FindCommentEnd(const ASource: string; StartPos: integer;
|
function FindCommentEnd(const ASource: string; StartPos: integer;
|
||||||
NestedComments: boolean): integer;
|
NestedComments: boolean): integer;
|
||||||
// returns position after the comment end, e.g. after {
|
// returns position after the comment end, e.g. after }
|
||||||
var
|
var
|
||||||
MaxPos, CommentLvl: integer;
|
MaxPos, CommentLvl: integer;
|
||||||
begin
|
begin
|
||||||
|
@ -33,7 +33,7 @@ interface
|
|||||||
uses
|
uses
|
||||||
Classes, SysUtils, AVL_Tree, contnrs,
|
Classes, SysUtils, AVL_Tree, contnrs,
|
||||||
FileProcs, CodeTree, CodeAtom, ExtractProcTool, FindDeclarationTool,
|
FileProcs, CodeTree, CodeAtom, ExtractProcTool, FindDeclarationTool,
|
||||||
LinkScanner, SourceChanger;
|
BasicCodeTools, KeywordFuncLists, LinkScanner, SourceChanger;
|
||||||
|
|
||||||
type
|
type
|
||||||
TChangeParamListAction = (
|
TChangeParamListAction = (
|
||||||
@ -66,6 +66,7 @@ type
|
|||||||
|
|
||||||
TChangeDeclarationTool = class(TExtractProcTool)
|
TChangeDeclarationTool = class(TExtractProcTool)
|
||||||
private
|
private
|
||||||
|
procedure CDTParseParamList(ParentNode: TCodeTreeNode; Transactions: TObject);
|
||||||
function ChangeParamListDeclaration(ParentNode: TCodeTreeNode;
|
function ChangeParamListDeclaration(ParentNode: TCodeTreeNode;
|
||||||
Changes: TObjectList; // list of TChangeParamListItem
|
Changes: TObjectList; // list of TChangeParamListItem
|
||||||
SourceChanger: TSourceChangeCache): boolean;
|
SourceChanger: TSourceChangeCache): boolean;
|
||||||
@ -87,7 +88,7 @@ type
|
|||||||
|
|
||||||
TChangeParamTransactionInsert = class
|
TChangeParamTransactionInsert = class
|
||||||
public
|
public
|
||||||
Src: string; // if Src='' then use Modifier+Name+Typ
|
Src: string; // if Src='' then use Modifier+Name+Typ+Value
|
||||||
Modifier: string;
|
Modifier: string;
|
||||||
Name: string;
|
Name: string;
|
||||||
Typ: string;
|
Typ: string;
|
||||||
@ -102,6 +103,17 @@ type
|
|||||||
TChangeParamTransactionPos = class
|
TChangeParamTransactionPos = class
|
||||||
public
|
public
|
||||||
Node: TCodeTreeNode; // old param node
|
Node: TCodeTreeNode; // old param node
|
||||||
|
// example: (var buf; {header} a,b:c; d:word=3 {footer}; ...)
|
||||||
|
HeaderCommentPos: integer;
|
||||||
|
Modifier: TAtomPosition; // ... (macpas varargs), const, var out, constref
|
||||||
|
Name: TAtomPosition; // '...' has no name
|
||||||
|
Typ: TAtomPosition;
|
||||||
|
DefaultValue: TAtomPosition;
|
||||||
|
HasComments: boolean;
|
||||||
|
FooterCommentEndPos: integer;
|
||||||
|
FirstInGroup: integer; // index of first parameter i a group, e.g. a,b:c
|
||||||
|
LastInGroup: integer;
|
||||||
|
|
||||||
Delete: boolean;
|
Delete: boolean;
|
||||||
NewDefaultValue: string;
|
NewDefaultValue: string;
|
||||||
InsertBehind: TObjectList;// list of TChangeParamTransactionInsert
|
InsertBehind: TObjectList;// list of TChangeParamTransactionInsert
|
||||||
@ -116,6 +128,9 @@ type
|
|||||||
OldNodes: array of TChangeParamTransactionPos; // one for each old param node
|
OldNodes: array of TChangeParamTransactionPos; // one for each old param node
|
||||||
InsertFirst: TObjectList;// list of TChangeParamTransactionInsert
|
InsertFirst: TObjectList;// list of TChangeParamTransactionInsert
|
||||||
Node: TCodeTreeNode; // ctnParameterList
|
Node: TCodeTreeNode; // ctnParameterList
|
||||||
|
BehindNamePos: integer;
|
||||||
|
BracketOpenPos: integer;
|
||||||
|
BracketClosePos: integer;
|
||||||
constructor Create(ParamList: TCodeTreeNode);
|
constructor Create(ParamList: TCodeTreeNode);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
function MaxPos: integer;
|
function MaxPos: integer;
|
||||||
@ -227,6 +242,112 @@ end;
|
|||||||
|
|
||||||
{ TChangeDeclarationTool }
|
{ TChangeDeclarationTool }
|
||||||
|
|
||||||
|
procedure TChangeDeclarationTool.CDTParseParamList(ParentNode: TCodeTreeNode;
|
||||||
|
Transactions: TObject);
|
||||||
|
var
|
||||||
|
t: TChangeParamListTransactions;
|
||||||
|
ParamIndex: Integer;
|
||||||
|
CurParam: TChangeParamTransactionPos;
|
||||||
|
FirstInGroup: integer;
|
||||||
|
i: LongInt;
|
||||||
|
CloseBracket: Char;
|
||||||
|
|
||||||
|
procedure ReadPrefixModifier;
|
||||||
|
begin
|
||||||
|
// read parameter prefix modifier
|
||||||
|
if UpAtomIs('VAR') or UpAtomIs('CONST') or UpAtomIs('CONSTREF')
|
||||||
|
or (UpAtomIs('OUT') and (Scanner.CompilerMode in [cmOBJFPC,cmDELPHI,cmFPC]))
|
||||||
|
then begin
|
||||||
|
CurParam.Modifier:=CurPos;
|
||||||
|
ReadNextAtom;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
t:=Transactions as TChangeParamListTransactions;
|
||||||
|
// parse param list
|
||||||
|
if ParentNode.Desc=ctnProcedureHead then
|
||||||
|
MoveCursorBehindProcName(ParentNode)
|
||||||
|
else if ParentNode.Desc=ctnProperty then
|
||||||
|
MoveCursorBehindPropName(ParentNode)
|
||||||
|
else
|
||||||
|
raise Exception.Create('TChangeDeclarationTool.ChangeParamListDeclaration kind not supported: '+ParentNode.DescAsString);
|
||||||
|
t.BehindNamePos:=LastAtoms.GetValueAt(0).EndPos;
|
||||||
|
// read bracket
|
||||||
|
if CurPos.Flag=cafRoundBracketOpen then
|
||||||
|
CloseBracket:=')'
|
||||||
|
else if CurPos.Flag=cafEdgedBracketOpen then
|
||||||
|
CloseBracket:=']'
|
||||||
|
else
|
||||||
|
exit; // no param list
|
||||||
|
|
||||||
|
t.BracketOpenPos:=CurPos.StartPos;
|
||||||
|
ParamIndex:=0;
|
||||||
|
ReadNextAtom;
|
||||||
|
repeat
|
||||||
|
CurParam:=t.OldNodes[ParamIndex];
|
||||||
|
FirstInGroup:=-1;
|
||||||
|
if AtomIs('...') then begin
|
||||||
|
// MacPas '...' VarArgs parameter
|
||||||
|
ReadNextAtom;
|
||||||
|
// parse end of parameter list
|
||||||
|
if (CurPos.StartPos>SrcLen)
|
||||||
|
or (Src[CurPos.StartPos]<>CloseBracket) then
|
||||||
|
RaiseCharExpectedButAtomFound(CloseBracket);
|
||||||
|
break;
|
||||||
|
end else begin
|
||||||
|
ReadPrefixModifier;
|
||||||
|
// read parameter name(s)
|
||||||
|
repeat
|
||||||
|
AtomIsIdentifier(true);
|
||||||
|
CurParam.Name:=CurPos;
|
||||||
|
ReadNextAtom;
|
||||||
|
if CurPos.Flag<>cafComma then
|
||||||
|
break;
|
||||||
|
// A group. Example: b,c:char;
|
||||||
|
if FirstInGroup<0 then FirstInGroup:=ParamIndex;
|
||||||
|
inc(ParamIndex);
|
||||||
|
CurParam:=t.OldNodes[ParamIndex];
|
||||||
|
ReadNextAtom;
|
||||||
|
until false;
|
||||||
|
if FirstInGroup>=0 then begin
|
||||||
|
for i:=FirstInGroup to ParamIndex do begin
|
||||||
|
t.OldNodes[i].FirstInGroup:=FirstInGroup;
|
||||||
|
t.OldNodes[i].LastInGroup:=ParamIndex;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
// read parameter type
|
||||||
|
if CurPos.Flag=cafColon then begin
|
||||||
|
ReadNextAtom;
|
||||||
|
CurParam.Typ:=CurPos;
|
||||||
|
if not ReadParamType(true,false,[]) then exit;
|
||||||
|
CurParam.Typ.EndPos:=LastAtoms.GetValueAt(0).EndPos;
|
||||||
|
if CurPos.Flag=cafEqual then begin
|
||||||
|
// read default value
|
||||||
|
ReadNextAtom;
|
||||||
|
CurParam.DefaultValue:=CurPos;
|
||||||
|
ReadConstant(true,false,[]);
|
||||||
|
CurParam.DefaultValue.EndPos:=LastAtoms.GetValueAt(0).EndPos;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
// close bracket or semicolon
|
||||||
|
if CurPos.Flag in [cafRoundBracketClose,cafEdgedBracketClose] then begin
|
||||||
|
t.BracketClosePos:=CurPos.StartPos;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
if CurPos.Flag<>cafSemicolon then
|
||||||
|
RaiseCharExpectedButAtomFound(CloseBracket);
|
||||||
|
inc(ParamIndex);
|
||||||
|
end;
|
||||||
|
until false;
|
||||||
|
|
||||||
|
// check for each parameter if it has comments
|
||||||
|
for i:=0 to t.MaxPos-1 do begin
|
||||||
|
CurParam:=t.OldNodes[i];
|
||||||
|
// ToDo:
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
function TChangeDeclarationTool.ChangeParamListDeclaration(
|
function TChangeDeclarationTool.ChangeParamListDeclaration(
|
||||||
ParentNode: TCodeTreeNode; Changes: TObjectList;
|
ParentNode: TCodeTreeNode; Changes: TObjectList;
|
||||||
SourceChanger: TSourceChangeCache): boolean;
|
SourceChanger: TSourceChangeCache): boolean;
|
||||||
@ -249,8 +370,7 @@ begin
|
|||||||
ParamListNode:=nil;
|
ParamListNode:=nil;
|
||||||
Transactions:=TChangeParamListTransactions.Create(ParamListNode);
|
Transactions:=TChangeParamListTransactions.Create(ParamListNode);
|
||||||
try
|
try
|
||||||
// ToDo: parse param list
|
CDTParseParamList(ParentNode,Transactions);
|
||||||
|
|
||||||
|
|
||||||
for i:=0 to Changes.Count-1 do begin
|
for i:=0 to Changes.Count-1 do begin
|
||||||
Change:=TChangeParamListItem(Changes[i]);
|
Change:=TChangeParamListItem(Changes[i]);
|
||||||
|
@ -164,11 +164,11 @@ const
|
|||||||
AllClassModifiers = [ctnClassAbstract, ctnClassSealed, ctnClassExternal];
|
AllClassModifiers = [ctnClassAbstract, ctnClassSealed, ctnClassExternal];
|
||||||
AllDefinitionSections =
|
AllDefinitionSections =
|
||||||
[ctnTypeSection,ctnVarSection,ctnConstSection,ctnResStrSection,
|
[ctnTypeSection,ctnVarSection,ctnConstSection,ctnResStrSection,
|
||||||
ctnLabelSection];
|
ctnLabelSection,ctnPropertySection];
|
||||||
AllIdentifierDefinitions =
|
|
||||||
[ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,ctnGenericType];
|
|
||||||
AllSimpleIdentifierDefinitions =
|
AllSimpleIdentifierDefinitions =
|
||||||
[ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition];
|
[ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition];
|
||||||
|
AllIdentifierDefinitions = AllSimpleIdentifierDefinitions
|
||||||
|
+[ctnGenericType,ctnGlobalProperty];
|
||||||
AllPascalTypes =
|
AllPascalTypes =
|
||||||
AllClasses+
|
AllClasses+
|
||||||
[ctnGenericType,ctnSpecialize,
|
[ctnGenericType,ctnSpecialize,
|
||||||
|
@ -1167,21 +1167,6 @@ function TPascalParserTool.ReadParamList(ExceptionOnError, Extract: boolean;
|
|||||||
procedure Intf.Method = ImplementingMethodName;
|
procedure Intf.Method = ImplementingMethodName;
|
||||||
function CommitUrlCacheEntry; // only Delphi
|
function CommitUrlCacheEntry; // only Delphi
|
||||||
procedure MacProcName(c: char; ...); external;
|
procedure MacProcName(c: char; ...); external;
|
||||||
|
|
||||||
proc specifiers without parameters:
|
|
||||||
stdcall, virtual, abstract, dynamic, overload, override, cdecl, inline
|
|
||||||
|
|
||||||
proc specifiers with parameters:
|
|
||||||
message <id or number>;
|
|
||||||
external;
|
|
||||||
external <id>;
|
|
||||||
external name <id> delayed;
|
|
||||||
external <id or number> name <id>;
|
|
||||||
external <id or number> index <id>;
|
|
||||||
[alias: <string constant>]
|
|
||||||
[external name <string constant>]
|
|
||||||
[internconst:in_const_round, external name 'FPC_ROUND'];
|
|
||||||
dispid <id>;
|
|
||||||
}
|
}
|
||||||
var CloseBracket: char;
|
var CloseBracket: char;
|
||||||
Desc: TCodeTreeNodeDesc;
|
Desc: TCodeTreeNodeDesc;
|
||||||
|
@ -70,6 +70,7 @@ type
|
|||||||
InUpperCase, EmptyIfIndexed: boolean): string;
|
InUpperCase, EmptyIfIndexed: boolean): string;
|
||||||
function MoveCursorToPropType(PropNode: TCodeTreeNode): boolean;
|
function MoveCursorToPropType(PropNode: TCodeTreeNode): boolean;
|
||||||
function MoveCursorToPropName(PropNode: TCodeTreeNode): boolean;
|
function MoveCursorToPropName(PropNode: TCodeTreeNode): boolean;
|
||||||
|
procedure MoveCursorBehindPropName(PropNode: TCodeTreeNode);
|
||||||
function ExtractPropName(PropNode: TCodeTreeNode;
|
function ExtractPropName(PropNode: TCodeTreeNode;
|
||||||
InUpperCase: boolean): string;
|
InUpperCase: boolean): string;
|
||||||
function ExtractProperty(PropNode: TCodeTreeNode;
|
function ExtractProperty(PropNode: TCodeTreeNode;
|
||||||
@ -1022,6 +1023,22 @@ begin
|
|||||||
Result:=CurPos.Flag=cafWord;
|
Result:=CurPos.Flag=cafWord;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TPascalReaderTool.MoveCursorBehindPropName(PropNode: TCodeTreeNode);
|
||||||
|
begin
|
||||||
|
if (PropNode=nil)
|
||||||
|
or ((PropNode.Desc<>ctnProperty) and (PropNode.Desc<>ctnGlobalProperty)) then
|
||||||
|
exit;
|
||||||
|
MoveCursorToNodeStart(PropNode);
|
||||||
|
ReadNextAtom;
|
||||||
|
if (PropNode.Desc=ctnProperty) then begin
|
||||||
|
if UpAtomIs('CLASS') then ReadNextAtom;
|
||||||
|
if (not UpAtomIs('PROPERTY')) then exit;
|
||||||
|
ReadNextAtom;
|
||||||
|
end;
|
||||||
|
if not AtomIsIdentifier(false) then exit;
|
||||||
|
ReadNextAtom;
|
||||||
|
end;
|
||||||
|
|
||||||
function TPascalReaderTool.ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
|
function TPascalReaderTool.ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
|
||||||
ProcSpec: TProcedureSpecifier): boolean;
|
ProcSpec: TProcedureSpecifier): boolean;
|
||||||
begin
|
begin
|
||||||
|
Loading…
Reference in New Issue
Block a user