paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-06 19:26:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: started GetPossibleInitsForVariable

Browse Source 
git-svn-id: trunk@47829 -
This commit is contained in:
mattias 2015-02-16 18:19:38 +00:00
parent 4f7de55302
commit 400a28bb34
7 changed files with 358 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -788,6 +788,7 @@ components/codetools/examples/h2pastest.lpi svneol=native#text/plain
components/codetools/examples/h2pastest.lpr svneol=native#text/plain
components/codetools/examples/identifiercompletion.lpi svneol=native#text/plain
components/codetools/examples/identifiercompletion.lpr svneol=native#text/plain
components/codetools/examples/initvariable.lpr svneol=native#text/plain
components/codetools/examples/listinterfaceclasses.lpi svneol=native#text/plain
components/codetools/examples/listinterfaceclasses.pas svneol=native#text/plain
components/codetools/examples/methodjumping.lpi svneol=native#text/plain
@ -829,6 +830,7 @@ components/codetools/examples/scanexamples/getcontextexample.pas svneol=native#t
components/codetools/examples/scanexamples/getterexample1.pas svneol=native#text/plain
components/codetools/examples/scanexamples/identcomplexample.pas svneol=native#text/plain
components/codetools/examples/scanexamples/indentation.pas svneol=native#text/plain
components/codetools/examples/scanexamples/initvars1.pas svneol=native#text/plain
components/codetools/examples/scanexamples/methodjump1.pas svneol=native#text/plain
components/codetools/examples/scanexamples/missingh2pasdirectives.pas svneol=native#text/plain
components/codetools/examples/scanexamples/modemacpas.pas svneol=native#text/plain

171
components/codetools/codecompletiontool.pas
View File

@ -76,6 +76,7 @@ interface
{off $DEFINE VerboseCompleteLocalVarAssign}
{off $DEFINE VerboseCompleteEventAssign}
{off $DEFINE EnableCodeCompleteTemplates}
{$DEFINE VerboseGetPossibleInitsForVariable}
uses
{$IFDEF MEM_CHECK}
@ -84,7 +85,8 @@ uses
Classes, SysUtils, FileProcs, CodeToolsStrConsts, CodeTree, CodeAtom,
CodeCache, CustomCodeTool, PascalParserTool, MethodJumpTool,
FindDeclarationTool, KeywordFuncLists, CodeToolsStructs, BasicCodeTools,
LinkScanner, SourceChanger, CodeGraph, AVL_Tree, CodeCompletionTemplater;
LinkScanner, SourceChanger, CodeGraph, AVL_Tree, contnrs,
CodeCompletionTemplater;
type
TNewClassPart = (ncpPrivateProcs, ncpPrivateVars,
@ -115,6 +117,14 @@ const
);
type
TInsertStatementPosDescription = class
public
InsertPos: integer;
CodeXYPos: TCodeXYPosition;
FrontGap, AfterGap: TGapTyp;
Description: string;
end;
TCodeCompletionCodeTool = class;
{ TCodeCompletionCodeTool }
@ -313,7 +323,7 @@ type
const Attr: TProcHeadAttributes;
out RemovedProcHeads: TStrings): boolean;
// assign/init records/classes
// assign records/classes
function FindAssignMethod(CursorPos: TCodeXYPosition;
out ClassNode: TCodeTreeNode;
out AssignDeclNode: TCodeTreeNode;
@ -330,6 +340,13 @@ type
LocalVarName: string = '' // default aSource
): boolean;
// local variables
function GetPossibleInitsForVariable(CursorPos: TCodeXYPosition;
out Statements: TStrings;
out InsertPositions: TObjectList; // list of TInsertStatementPosDescription
SourceChangeCache: TSourceChangeCache = nil // needed for Beautifier
): boolean;
// guess type of an undeclared identifier
function GuessTypeOfIdentifier(CursorPos: TCodeXYPosition;
out IsKeyword, IsSubIdentifier: boolean;
@ -5984,6 +6001,156 @@ begin
NewPos,NewTopLine);
end;
function TCodeCompletionCodeTool.GetPossibleInitsForVariable(
CursorPos: TCodeXYPosition; out Statements: TStrings; out
InsertPositions: TObjectList; SourceChangeCache: TSourceChangeCache): boolean;
var
Identifier: PChar;
procedure AddStatement(aStatement: string);
begin
if SourceChangeCache<>nil then begin
SourceChangeCache.MainScanner:=Scanner;
SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(aStatement,0);
end;
{$IFDEF VerboseGetPossibleInitsForVariable}
debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable.AddStatement "',aStatement,'"']);
{$ENDIF}
Statements.Add(aStatement);
end;
procedure AddAssignment(const aValue: string);
begin
AddStatement(GetIdentifier(Identifier)+':='+aValue+';');
end;
var
CleanCursorPos: integer;
CursorNode: TCodeTreeNode;
IdentAtom: TAtomPosition;
Params: TFindDeclarationParams;
VarTool: TFindDeclarationTool;
VarNode: TCodeTreeNode;
ExprType: TExpressionType;
BeginNode: TCodeTreeNode;
InsertPosDesc: TInsertStatementPosDescription;
begin
{$IFDEF VerboseGetPossibleInitsForVariable}
debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable ',dbgs(CursorPos)]);
{$ENDIF}
Result:=false;
Statements:=TStringList.Create;
InsertPositions:=TObjectList.create(true);
BuildTreeAndGetCleanPos(CursorPos, CleanCursorPos);
// find variable name
GetIdentStartEndAtPosition(Src,CleanCursorPos,
IdentAtom.StartPos,IdentAtom.EndPos);
{$IFDEF VerboseGetPossibleInitsForVariable}
debugln('TCodeCompletionCodeTool.GetPossibleInitsForLocalVar IdentAtom="',dbgstr(Src,IdentAtom.StartPos,IdentAtom.EndPos-IdentAtom.StartPos),'"');
{$ENDIF}
if IdentAtom.StartPos=IdentAtom.EndPos then exit;
// find context
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
// find declaration of identifier
Identifier:=@Src[IdentAtom.StartPos];
Params:=TFindDeclarationParams.Create;
try
Params.ContextNode:=CursorNode;
Params.SetIdentifier(Self,Identifier,nil);
Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,
fdfTopLvlResolving,fdfFindVariable];
Result:=FindIdentifierInContext(Params);
VarTool:=Params.NewCodeTool;
VarNode:=Params.NewNode;
if (not Result) or (VarNode=nil) then begin
{$IFDEF VerboseGetPossibleInitsForVariable}
debugln(['TCodeCompletionCodeTool.GetPossibleInitsForVariable FindIdentifierInContext Result=',Result,' VarTool=',VarTool<>nil,' VarNode=',VarNode<>nil]);
{$ENDIF}
MoveCursorToAtomPos(IdentAtom);
RaiseException('failed to resolve identifier "'+Identifier+'"');
end;
finally
Params.Free;
end;
// resolve type
Params:=TFindDeclarationParams.Create;
try
ExprType:=VarTool.ConvertNodeToExpressionType(VarNode,Params);
{$IFDEF VerboseGetPossibleInitsForVariable}
DebugLn('TCodeCompletionCodeTool.GetPossibleInitsForVariable ConvertNodeToExpressionType',
' Expr=',ExprTypeToString(ExprType));
{$ENDIF}
finally
Params.Free;
end;
case ExprType.Desc of
// ToDo: sets, ranges, records, objects, pointer, class, class of, interface
//xtContext: ;
xtChar,
xtWideChar: begin AddAssignment('#0'); AddAssignment(''' '''); end;
xtReal,
xtSingle,
xtDouble,
xtExtended,
xtCExtended: begin AddAssignment('0.0'); AddAssignment('1.0'); end;
xtCurrency: AddAssignment('0.00');
xtComp,
xtInt64,
xtCardinal,
xtQWord: AddAssignment('0');
xtBoolean,
xtByteBool,
xtWordBool,
xtLongBool,
xtQWordBool: begin AddAssignment('False'); AddAssignment('True'); end;
xtString,
xtAnsiString,
xtShortString,
xtWideString,
xtUnicodeString: AddAssignment('''''');
xtPChar: begin AddAssignment('nil'); AddAssignment('#0'); end;
xtPointer: AddAssignment('nil');
xtLongint,
xtLongWord,
xtWord,
xtSmallInt,
xtShortInt,
xtByte: AddAssignment('0');
xtVariant: begin AddAssignment('0'); AddAssignment(''''''); end;
end;
if Statements.Count=0 then begin
MoveCursorToAtomPos(IdentAtom);
RaiseException('auto initialize not yet implemented for identifier "'+Identifier+'" of type "'+ExprTypeToString(ExprType)+'"');
end;
// find possible insert positions
BeginNode:=CursorNode.GetNodeOfType(ctnBeginBlock);
if BeginNode<>nil then begin
InsertPosDesc:=TInsertStatementPosDescription.Create;
InsertPosDesc.InsertPos:=BeginNode.StartPos+length('begin');
CleanPosToCaret(InsertPosDesc.InsertPos,InsertPosDesc.CodeXYPos);
InsertPosDesc.FrontGap:=gtNewLine;
InsertPosDesc.AfterGap:=gtNewLine;
InsertPosDesc.Description:='After BEGIN keyword';
if (BeginNode.Parent<>nil) then begin
if BeginNode.Parent.Desc=ctnProcedure then
InsertPosDesc.Description+=' of '
+ExtractProcHead(BeginNode.Parent,[phpWithStart,phpAddClassName,phpWithoutParamList]);
end;
InsertPositions.Add(InsertPosDesc);
end;
if InsertPositions.Count=0 then begin
MoveCursorToAtomPos(IdentAtom);
RaiseException('auto initialize not yet implemented for this context (Node='+CursorNode.DescAsString+')');
end;
end;
function TCodeCompletionCodeTool.GuessTypeOfIdentifier(
CursorPos: TCodeXYPosition; out IsKeyword, IsSubIdentifier: boolean;
out ExistingDefinition: TFindContext; out ListOfPFindContext: TFPList;

27
components/codetools/codetoolmanager.pas
View File

@ -564,6 +564,9 @@ type
out ExistingDefinition: TFindContext; // next existing definition
out ListOfPFindContext: TFPList; // possible classes
out NewExprType: TExpressionType; out NewType: string): boolean; // false = not at an identifier or syntax error
function GetPossibleInitsForVariable(Code: TCodeBuffer; X,Y: integer;
out Statements: TStrings; out InsertPositions: TObjectList // e.g. [use unit1, unit2;]i:=0;
): boolean;
function DeclareVariableNearBy(Code: TCodeBuffer; X,Y: integer;
const VariableName, NewType, NewUnitName: string;
Visibility: TCodeTreeNodeDesc;
@ -4191,6 +4194,28 @@ begin
end;
end;
function TCodeToolManager.GetPossibleInitsForVariable(Code: TCodeBuffer; X,
Y: integer; out Statements: TStrings; out InsertPositions: TObjectList
): boolean;
var
CursorPos: TCodeXYPosition;
begin
{$IFDEF CTDEBUG}
DebugLn(['TCodeToolManager.GetPossibleInitsForVariable A ',Code.Filename,' X=',X,' Y=',Y]);
{$ENDIF}
Result:=false;
if not InitCurCodeTool(Code) then exit;
CursorPos.Code:=Code;
CursorPos.X:=X;
CursorPos.Y:=Y;
try
Result:=FCurCodeTool.GetPossibleInitsForVariable(CursorPos,Statements,
InsertPositions,SourceChangeCache);
except
on e: Exception do Result:=HandleException(e);
end;
end;
function TCodeToolManager.DeclareVariableNearBy(Code: TCodeBuffer; X,
Y: integer; const VariableName, NewType, NewUnitName: string;
Visibility: TCodeTreeNodeDesc; LvlPosCode: TCodeBuffer; LvlPosX: integer;
@ -5801,7 +5826,7 @@ begin
FCurCodeTool.JumpCentered:=NewValue;
end;
procedure TCodeToolManager.SetSetPropertyVariablename(aValue: string);
procedure TCodeToolManager.SetSetPropertyVariablename(AValue: string);
begin
if FSetPropertyVariablename=aValue then Exit;
FSetPropertyVariablename:=aValue;

59
components/codetools/definetemplates.pas
View File

@ -1538,6 +1538,7 @@ function ParseFPCVerbose(List: TStrings; const WorkDir: string; out
SymbolName, SymbolValue, UpLine, NewPath: string;
i, len, CurPos: integer;
Filename: String;
p: SizeInt;
begin
//DebugLn(['ProcessOutputLine ',Line]);
Line:=SysToUtf8(Line);
@ -1556,9 +1557,29 @@ function ParseFPCVerbose(List: TStrings; const WorkDir: string; out
end;
UpLine:=UpperCaseStr(Line);
//DebugLn(['ProcessOutputLine ',Line]);
case UpLine[CurPos] of
'C':
if StrLComp(@UpLine[CurPos], 'CONFIGFILE SEARCH: ', 19) = 0 then
begin
// skip keywords
Inc(CurPos, 19);
Filename:=ExpFile(SetDirSeparators(copy(Line,CurPos,length(Line))));
ConfigFiles.Add('-'+Filename);
end else if StrLComp(@UpLine[CurPos], 'COMPILER: ', 10) = 0 then begin
// skip keywords
Inc(CurPos, 10);
RealCompilerFilename:=ExpFile(copy(Line,CurPos,length(Line)));
end;
'E':
if StrLComp(@UpLine[CurPos], 'ERROR: ', 7) = 0 then begin
inc(CurPos,7);
if RealCompilerFilename='' then begin
p:=Pos(' returned an error exitcode',Line);
if p>0 then
RealCompilerFilename:=copy(Line,CurPos,p-CurPos);
end;
end;
'M':
if StrLComp(@UpLine[CurPos], 'MACRO ', 6) = 0 then begin
// skip keyword macro
@ -1590,6 +1611,17 @@ function ParseFPCVerbose(List: TStrings; const WorkDir: string; out
DefineSymbol(SymbolName, SymbolValue);
end;
end;
'R':
if StrLComp(@UpLine[CurPos], 'READING OPTIONS FROM FILE ', 26) = 0 then
begin
// skip keywords
Inc(CurPos, 26);
Filename:=ExpFile(SetDirSeparators(copy(Line,CurPos,length(Line))));
if (ConfigFiles.Count>0)
and (ConfigFiles[ConfigFiles.Count-1]='-'+Filename) then
ConfigFiles.Delete(ConfigFiles.Count-1);
ConfigFiles.Add('+'+Filename);
end;
'U':
if (StrLComp(@UpLine[CurPos], 'USING UNIT PATH: ', 17) = 0) then begin
Inc(CurPos, 17);
@ -1602,29 +1634,6 @@ function ParseFPCVerbose(List: TStrings; const WorkDir: string; out
{$ENDIF}
UnitPaths.Add(NewPath);
end;
'C':
if StrLComp(@UpLine[CurPos], 'CONFIGFILE SEARCH: ', 19) = 0 then
begin
// skip keywords
Inc(CurPos, 19);
Filename:=ExpFile(SetDirSeparators(copy(Line,CurPos,length(Line))));
ConfigFiles.Add('-'+Filename);
end else if StrLComp(@UpLine[CurPos], 'COMPILER: ', 10) = 0 then begin
// skip keywords
Inc(CurPos, 10);
RealCompilerFilename:=ExpFile(copy(Line,CurPos,length(Line)));
end;
'R':
if StrLComp(@UpLine[CurPos], 'READING OPTIONS FROM FILE ', 26) = 0 then
begin
// skip keywords
Inc(CurPos, 26);
Filename:=ExpFile(SetDirSeparators(copy(Line,CurPos,length(Line))));
if (ConfigFiles.Count>0)
and (ConfigFiles[ConfigFiles.Count-1]='-'+Filename) then
ConfigFiles.Delete(ConfigFiles.Count-1);
ConfigFiles.Add('+'+Filename);
end;
end;
end;
@ -5971,7 +5980,7 @@ begin
DefaultSrcOS2:=GetDefaultSrcOS2ForTargetOS(DefaultTargetOS);
if (FPCSrcDir='') or (not DirPathExists(FPCSrcDir)) then begin
DebugLn(['TDefinePool.CreateFPCSrcTemplate FPCSrcDir does not exist: FPCSrcDir="',FPCSrcDir,'"']);
DebugLn(['TDefinePool.CreateFPCSrcTemplate FPCSrcDir does not exist: FPCSrcDir="',FPCSrcDir,'" (env FPCDIR)']);
exit;
end;
// try to find for every reachable ppu file the unit file in the FPC sources

100
components/codetools/examples/initvariable.lpr Normal file
View File

@ -0,0 +1,100 @@
{
***************************************************************************
* *
* 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:
Simple demonstration, how to setup the codetools to insert a simple
Pascal statement to initialize a variable.
}
program initvariable;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, contnrs, CodeCache, CodeToolManager, DefineTemplates,
FileProcs, CodeToolsConfig, CodeToolsStructs, CodeCompletionTool, initvars1;
const
ConfigFilename = 'codetools.config';
var
Code: TCodeBuffer;
X: Integer;
Y: Integer;
Filename: String;
Statements: TStrings;
InsertPositions: TObjectList;
InsertPosDesc: TInsertStatementPosDescription;
i: Integer;
begin
if (ParamCount>=1) and (Paramcount<>3) then begin
writeln('Usage:');
writeln(' ',ParamStr(0));
writeln(' ',ParamStr(0),' <filename> <X> <Y>');
end;
try
CodeToolBoss.SimpleInit(ConfigFilename);
X:=15;
Y:=21;
Filename:=ExpandFileName('scanexamples'+PathDelim+'initvars1.pas');
if (ParamCount>=3) then begin
Filename:=ExpandFileName(ParamStr(1));
X:=StrToInt(ParamStr(2));
Y:=StrToInt(ParamStr(3));
end;
// Step 1: load the file
Code:=CodeToolBoss.LoadFile(Filename,false,false);
if Code=nil then
raise Exception.Create('loading failed '+Filename);
// get possible initializations
Statements:=nil;
InsertPositions:=nil;
try
if not CodeToolBoss.GetPossibleInitsForVariable(Code,X,Y,Statements,
InsertPositions)
then begin
writeln('CodeToolBoss.GetPossibleInitsForVariable failed');
exit;
end;
writeln('Possible initialization statements:');
writeln(Statements.Text);
writeln('Possible initialization positions:');
for i:=0 to InsertPositions.Count-1 do begin
InsertPosDesc:=TInsertStatementPosDescription(InsertPositions[i]);
with InsertPosDesc do begin
writeln(CodeXYPos.Code.Filename,'(',CodeXYPos.Y,',',CodeXYPos.X,'): ',Description);
end;
end;
finally
Statements.Free;
InsertPositions.Free;
end;
except
on E: Exception do begin
writeln('EXCEPTION: '+E.Message);
end;
end;
end.

8
components/codetools/examples/removeemptymethods.lpi
View File

@ -8,7 +8,8 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="finddeclaration"/>
<Title Value="removeemptymethods"/>
<ResourceType Value="res"/>
</General>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
@ -33,12 +34,10 @@
<Unit0>
<Filename Value="removeemptymethods.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="RemoveEmptyMethods"/>
</Unit0>
<Unit1>
<Filename Value="scanexamples/emptymethods1.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="EmptyMethods1"/>
</Unit1>
<Unit2>
<Filename Value="README.txt"/>
@ -56,8 +55,5 @@
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

25
components/codetools/examples/scanexamples/initvars1.pas Normal file
View File

@ -0,0 +1,25 @@
unit InitVars1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
implementation
procedure TestInteger(var i: integer);
begin
writeln(i);
end;
procedure DoSomething;
var
i: integer;
begin
TestInteger(i);
end;
end.