paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-09 19:57:45 +01:00
Code Issues Packages Projects Releases Wiki Activity

MG: small fixes, cleanups and started event assignment completion

Browse Source 
git-svn-id: trunk@1600 -
This commit is contained in:
lazarus 2002-04-11 08:08:50 +00:00
parent b9aa246069
commit 9b66e0abc7
16 changed files with 1345 additions and 1038 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/codetools/basiccodetools.pas
View File

@ -121,6 +121,8 @@ function ReadRawNextPascalAtom(const Source:string;
//----------------------------------------------------------------------------
procedure GetLineStartEndAtPosition(const Source:string; Position:integer;
var LineStart,LineEnd:integer);
procedure GetIdentStartEndAtPosition(const Source:string; Position:integer;
var IdentStart,IdentEnd:integer);
function LineEndCount(const Txt: string; var LengthOfLastLine:integer): integer;
function FindFirstNonSpaceCharInLine(const Source: string;
Position: integer): integer;
@ -896,6 +898,19 @@ begin
inc(LineEnd);
end;
procedure GetIdentStartEndAtPosition(const Source: string; Position: integer;
var IdentStart, IdentEnd: integer);
begin
IdentStart:=Position;
IdentEnd:=Position;
while (IdentStart>1)
and (IsIdChar[Source[IdentStart-1]]) do
dec(IdentStart);
while (IdentEnd<=length(Source))
and (IsIdChar[Source[IdentEnd]]) do
inc(IdentEnd);
end;
function ReadNextPascalAtom(const Source:string;
var Position,AtomStart:integer):string;
var DirectiveName:string;
@ -1465,7 +1480,7 @@ var LineStart, LineEnd: integer;
begin
GetLineStartEndAtPosition(Source,FromPos,LineStart,LineEnd);
Result:=((LineEnd>=FromPos) and (LineEnd<ToPos))
or ((LineEnd-(ToPos-FromPos)+NewLength)>MaxLineLength);
or ((LineEnd-LineStart-(ToPos-FromPos)+NewLength)>MaxLineLength);
end;
function CompareTextIgnoringSpace(const Txt1, Txt2: string;
@ -1773,7 +1788,6 @@ begin
end;
end;
initialization
BasicCodeToolInit;

1284
components/codetools/codecompletiontool.pas
View File

File diff suppressed because it is too large Load Diff

8
components/codetools/codetoolmanager.pas
View File

@ -78,7 +78,8 @@ type
FWriteExceptions: boolean;
FWriteLockCount: integer;// Set/Unset counter
FWriteLockStep: integer; // current write lock ID
function OnScannerGetInitValues(Code: Pointer): TExpressionEvaluator;
function OnScannerGetInitValues(Code: Pointer;
var AChangeStep: integer): TExpressionEvaluator;
procedure OnDefineTreeReadValue(Sender: TObject; const VariableName: string;
var Value: string);
procedure OnGlobalValuesChanged;
@ -1294,10 +1295,11 @@ writeln('TCodeToolManager.RemovePublishedVariable A ',Code.Filename,' ',AClassNa
end;
end;
function TCodeToolManager.OnScannerGetInitValues(
Code: Pointer): TExpressionEvaluator;
function TCodeToolManager.OnScannerGetInitValues(Code: Pointer;
var AChangeStep: integer): TExpressionEvaluator;
begin
Result:=nil;
AChangeStep:=DefineTree.ChangeStep;
if Code=nil then exit;
//DefineTree.WriteDebugReport;
if not TCodeBuffer(Code).IsVirtual then

2
components/codetools/customcodetool.pas
View File

@ -1234,7 +1234,7 @@ begin
// find the CursorPos in cleaned source
Dummy:=CaretToCleanPos(CursorPos, CleanCursorPos);
if (Dummy<>0) and (Dummy<>-1) then
SaveRaiseException(ctsCursorPosOutsideOfCode);
RaiseException(ctsCursorPosOutsideOfCode);
end;
procedure TCustomCodeTool.MoveCursorToNodeStart(ANode: TCodeTreeNode);

18
components/codetools/definetemplates.pas
View File

@ -207,11 +207,13 @@ type
private
FFirstDefineTemplate: TDefineTemplate;
FCache: TAVLTree; // tree of TDirectoryDefines
FChangeStep: integer;
FVirtualDirCache: TDirectoryDefines;
FOnReadValue: TOnReadValue;
FErrorTemplate: TDefineTemplate;
FErrorDescription: string;
function Calculate(DirDef: TDirectoryDefines): boolean;
procedure IncreaseChangeStep;
protected
function FindDirectoryInCache(const Path: string): TDirectoryDefines;
public
@ -220,6 +222,8 @@ type
property OnReadValue: TOnReadValue read FOnReadValue write FOnReadValue;
property ErrorTemplate: TDefineTemplate read FErrorTemplate;
property ErrorDescription: string read FErrorDescription;
property ChangeStep: integer read FChangeStep;
public
function GetDefinesForDirectory(const Path: string): TExpressionEvaluator;
function GetDefinesForVirtualDirectory: TExpressionEvaluator;
procedure AddFirst(ADefineTemplate: TDefineTemplate);
@ -1247,9 +1251,11 @@ end;
procedure TDefineTree.ClearCache;
begin
if (FCache.Count=0) or (FVirtualDirCache=nil) then exit;
FCache.FreeAndClear;
FVirtualDirCache.Free;
FVirtualDirCache:=nil;
IncreaseChangeStep;
end;
constructor TDefineTree.Create;
@ -1296,6 +1302,7 @@ begin
NewFirstNode:=NewFirstNode.Next;
FFirstDefineTemplate.RemoveMarked;
FFirstDefineTemplate:=NewFirstNode;
ClearCache;
end;
procedure TDefineTree.RemoveGlobals;
@ -1614,6 +1621,14 @@ begin
Result:=(ErrorTemplate=nil);
end;
procedure TDefineTree.IncreaseChangeStep;
begin
if FChangeStep<>$7fffffff then
inc(FChangeStep)
else
FChangeStep:=-$7fffffff;
end;
function TDefineTree.LoadFromXMLConfig(XMLConfig: TXMLConfig;
const Path: string; Policy: TDefineTreeLoadPolicy;
const NewNamePrefix: string): boolean;
@ -1640,6 +1655,7 @@ begin
end;
end;
// import new defines
ClearCache;
LastDefTempl:=FFirstDefineTemplate;
if LastDefTempl<>nil then begin
while LastDefTempl.Next<>nil do
@ -1689,6 +1705,7 @@ begin
LastDefTempl:=LastDefTempl.Next;
ADefineTemplate.InsertBehind(LastDefTempl);
end;
ClearCache;
end;
procedure TDefineTree.AddFirst(ADefineTemplate: TDefineTemplate);
@ -1701,6 +1718,7 @@ begin
RootTemplate.InsertBehind(ADefineTemplate);
RootTemplate:=ADefineTemplate;
end;
ClearCache;
end;
function TDefineTree.FindDefineTemplateByName(

29
components/codetools/eventcodetool.pas
View File

@ -223,6 +223,7 @@ begin
writeln('[TEventsCodeTool.GetCompatiblePublishedMethods]');
{$ENDIF}
// 1. convert the TypeData to an expression type list
CheckDependsOnNodeCaches;
Params:=TFindDeclarationParams.Create;
try
Params.ContextNode:=ClassNode.Parent;
@ -267,6 +268,7 @@ begin
or (Scanner=nil) then exit;
ActivateGlobalWriteLock;
try
CheckDependsOnNodeCaches;
Params:=TFindDeclarationParams.Create;
try
Params.ContextNode:=ClassNode;
@ -329,6 +331,7 @@ begin
try
// find method type declaration
TypeName:=ATypeInfo^.Name;
CheckDependsOnNodeCaches;
Params:=TFindDeclarationParams.Create;
try
// find method type in used units
@ -396,6 +399,7 @@ begin
MethodIsPublished:=false;
ActivateGlobalWriteLock;
try
CheckDependsOnNodeCaches;
Params:=TFindDeclarationParams.Create;
try
// first search a published method definition with same name
@ -608,9 +612,7 @@ begin
if TypeData=nil then exit;
ParamCount:=TypeData^.ParamCount;
if ParamCount>0 then begin
//Result:=Result+'(';
//ParamString:='';
CheckDependsOnNodeCaches;
Offset:=0;
for i:=0 to ParamCount-1 do begin
@ -659,29 +661,8 @@ begin
Result.AddFirst(CurExprType);
Params.Load(OldInput);
{// 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;
function TEventsCodeTool.CollectPublishedMethods(

816
components/codetools/finddeclarationtool.pas
View File

@ -269,6 +269,7 @@ type
FDependentCodeTools: TAVLTree;// the codetools, that depend on this codetool
FDependsOnCodeTools: TAVLTree;// the codetools, that this codetool depends on
FClearingDependentNodeCaches: boolean;
FCheckingNodeCacheDependencies: boolean;
{$IFDEF CTDEBUG}
DebugPrefix: string;
procedure IncPrefix;
@ -305,6 +306,8 @@ type
function NodeIsInAMethod(Node: TCodeTreeNode): boolean;
protected
procedure DoDeleteNodes; override;
function NodeCacheGlobalWriteLockStepDidNotChange: boolean;
function CheckDependsOnNodeCaches: boolean;
procedure ClearNodeCaches(Force: boolean);
procedure ClearDependentNodeCaches;
procedure ClearDependsOnToolRelationships;
@ -553,6 +556,7 @@ begin
{$IFDEF CTDEBUG}
writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration A CursorPos=',CursorPos.X,',',CursorPos.Y);
{$ENDIF}
CheckDependsOnNodeCaches;
BuildTreeAndGetCleanPos(false,CursorPos,CleanCursorPos);
{$IFDEF CTDEBUG}
writeln(DebugPrefix,'TFindDeclarationTool.FindDeclaration C CleanCursorPos=',CleanCursorPos);
@ -1555,15 +1559,379 @@ var CurAtom, NextAtom: TAtomPosition;
NextAtomType, CurAtomType: TAtomType;
ProcNode, FuncResultNode: TCodeTreeNode;
ExprType: TExpressionType;
procedure ReadCurrentAndPriorAtom;
begin
NextAtom:=CurPos;
NextAtomType:=GetCurrentAtomType;
ReadPriorAtom;
CurAtom:=CurPos;
CurAtomType:=GetCurrentAtomType;
end;
function IsStartOfVariable(var FindContext: TFindContext): boolean;
begin
Result:=true;
if CurAtom.StartPos<Params.ContextNode.StartPos then begin
// this is the start of the variable
FindContext:=CreateFindContext(Self,Params.ContextNode);
exit;
end;
if (not (CurAtomType in [atIdentifier,atPreDefIdentifier,atPoint,atUp,
atEdgedBracketClose,atRoundBracketClose]))
or ((CurAtomType in [atIdentifier,atPreDefIdentifier,atNone])
and (NextAtomType in [atIdentifier,atPreDefIdentifier]))
then begin
// the next atom is the start of the variable
if (not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier,
atRoundBracketOpen,atEdgedBracketOpen,atAddrOp])) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end;
FindContext:=CreateFindContext(Self,Params.ContextNode);
exit;
end;
Result:=false;
end;
procedure ResolveIdentifier;
begin
// for example 'AnObject[3]'
// check syntax
if not (NextAtomType in [atSpace,atPoint,atUp,atAS,atRoundBracketOpen,
atRoundBracketClose,atEdgedBracketOpen,atEdgedBracketClose]) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
// check special identifiers 'Result' and 'Self'
if (Result.Node=Params.ContextNode) then begin
if CompareSrcIdentifier(CurAtom.StartPos,'SELF') then begin
// SELF in a method is the object itself
// -> check if in a proc
ProcNode:=Params.ContextNode;
while (ProcNode<>nil) do begin
if (ProcNode.Desc=ctnProcedure) then begin
// in a proc -> find the class context
if Result.Tool.FindClassOfMethod(ProcNode,Params,true) then begin
Result:=CreateFindContext(Params);
exit;
end;
end;
ProcNode:=ProcNode.Parent;
end;
end else if CompareSrcIdentifier(CurAtom.StartPos,'RESULT') then begin
// RESULT has a special meaning in a function
// -> check if in a function
ProcNode:=Params.ContextNode;
while (ProcNode<>nil) do begin
if (ProcNode.Desc=ctnProcedure) then begin
Params.Save(OldInput);
Include(Params.Flags,fdfFunctionResult);
Result:=Result.Tool.FindBaseTypeOfNode(Params,ProcNode);
Params.Load(OldInput);
exit;
end;
ProcNode:=ProcNode.Parent;
end;
end;
end;
{ ToDo: check, if this is needed for Delphi:
if (NextAtomType in [atSpace])
and CompareSrcIdentifier(CurAtom.StartPos,'FREE')
and ((Result.Node.Desc=ctnClass) or NodeIsInAMethod(Result.Node)) then
begin
// FREE calls the destructor of an object
Params.Save(OldInput);
Params.SetIdentifier(Self,'DESTRUCTOR',nil);
Exclude(Params.Flags,fdfExceptionOnNotFound);
if Result.Tool.FindIdentifierInContext(Params) then begin
Result:=CreateFindContext(Params);
exit;
end;
Params.Load(OldInput);
end;}
// find sub identifier
Params.Save(OldInput);
try
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound]
+fdfAllClassVisibilities
+(fdfGlobals*Params.Flags);
if CurAtomType=atPreDefIdentifier then
Exclude(Params.Flags,fdfExceptionOnNotFound);
if Result.Node=Params.ContextNode then begin
// there is no special context -> also search in parent contexts
Params.Flags:=Params.Flags
+[fdfSearchInParentNodes,fdfIgnoreCurContextNode];
end else
// special context
Params.ContextNode:=Result.Node;
Params.SetIdentifier(Self,@Src[CurAtom.StartPos],@CheckSrcIdentifier);
if Result.Tool.FindIdentifierInContext(Params) then begin
Result:=CreateFindContext(Params);
end else begin
// predefined identifier not redefined
Result:=CreateFindContext(Self,nil);
end;
// ToDo: check if identifier in 'Protected' section
finally
Params.Load(OldInput);
end;
// find base type
if Result.Node<>nil then begin
if (Result.Node<>nil)
and (Result.Node.Desc in [ctnProcedure,ctnProcedureHead]) then begin
Result.Tool.BuildSubTreeForProcHead(Result.Node,FuncResultNode);
if FuncResultNode<>nil then begin
// this is function
if (NextAtomType in [atSpace,atNone,atRoundBracketClose,
atEdgedBracketClose])
then begin
// this identifier is the end of the variable
// In Delphi Mode or if there is a @ qualifier return the
// function and not the result type
//if (Scanner.CompilerMode=cmDelphi) or
// ToDo:
end;
// Otherwise return the result type
Include(Params.Flags,fdfFunctionResult);
end;
end;
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node);
end;
end;
procedure ResolvePoint;
begin
// for example 'A.B'
if Result.Node=Params.ContextNode then begin
MoveCursorToCleanPos(CurAtom.StartPos);
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,'.']);
end;
if (not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier])) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end;
if (Result.Node.Desc in AllUsableSourceTypes) then begin
// identifier in front of the point is a unit name
if Result.Tool<>Self then begin
Result.Node:=Result.Tool.GetInterfaceNode;
end else begin
Result:=CreateFindContext(Self,Params.ContextNode);
end;
end;
// there is no special left to do, since Result already points to
// the type context node.
end;
procedure ResolveAs;
begin
// for example 'A as B'
if (not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier])) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end;
// 'as' is a type cast, so the left side is irrelevant and was already
// ignored in the code at the start of this proc
// -> context is default context
end;
procedure ResolveUp;
begin
// for example:
// 1. 'PInt = ^integer' pointer type
// 2. a^ dereferencing
if not (NextAtomType in [atSpace,atPoint,atUp,atAS,atEdgedBracketOpen])
then begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
if Result.Node<>Params.ContextNode then begin
// left side of expression has defined a special context
// => this '^' is a dereference
if (not (NextAtomType in [atSpace,atPoint,atAS,atUP,atEdgedBracketOpen]))
then begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,['.',GetAtom]);
end;
if Result.Node.Desc<>ctnPointerType then begin
MoveCursorToCleanPos(CurAtom.StartPos);
RaiseExceptionFmt(ctsIllegalQualifier,['^']);
end;
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild);
end else if NodeHasParentOfType(Result.Node,ctnPointerType) then begin
//end else if Result.Node.Parent.Desc=ctnPointerType then begin
// this is a pointer type definition
// -> the default context is ok
end;
end;
procedure ResolveEdgedBracketClose;
begin
{ for example: a[]
this could be:
1. ranged array
2. dynamic array
3. indexed pointer
4. default property
5. indexed property
6. string character
}
if not (NextAtomType in [atSpace,atPoint,atAs,atUp,atRoundBracketClose,
atRoundBracketOpen,atEdgedBracketClose,atEdgedBracketOpen]) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
if Result.Node<>Params.ContextNode then begin
case Result.Node.Desc of
ctnArrayType:
// the array type is the last child node
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.LastChild);
ctnPointerType:
// the pointer type is the only child node
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild);
ctnClass:
begin
// search default property in class
Params.Save(OldInput);
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound]
+fdfGlobals*Params.Flags
+fdfAllClassVisibilities*Params.Flags;
// special identifier for default property
Params.SetIdentifier(Self,'[',nil);
Params.ContextNode:=Result.Node;
Result.Tool.FindIdentifierInContext(Params);
Result:=Params.NewCodeTool.FindBaseTypeOfNode(
Params,Params.NewNode);
Params.Load(OldInput);
end;
ctnIdentifier:
begin
MoveCursorToNodeStart(Result.Node);
ReadNextAtom;
if UpAtomIs('STRING') or UpAtomIs('ANSISTRING')
or UpAtomIs('SHORTSTRING') then begin
if not (fdfNoExceptionOnStringChar in Params.Flags) then begin
MoveCursorToCleanPos(CurAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
end;
end;
ctnProperty:
begin
// indexed property without base type
// => property type is predefined
// -> completed
end;
else
MoveCursorToCleanPos(CurAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
end;
end;
procedure ResolveRoundBracketClose;
begin
{ for example:
(a+b) expression bracket: the type is the result type of the
expression.
a() typecast or function
}
if not (NextAtomType in [atSpace,atPoint,atAs,atUp,atRoundBracketClose,
atRoundBracketOpen,atEdgedBracketClose,atEdgedBracketOpen]) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
if Result.Node<>Params.ContextNode then begin
// typecast or function
end else begin
// expression
ExprType:=FindExpressionResultType(Params,CurAtom.StartPos+1,
CurAtom.EndPos-1);
if (ExprType.Context.Node=nil) then begin
MoveCursorToCleanPos(CurAtom.StartPos);
ReadNextAtom;
RaiseException(ctsExprTypeIsNotVariable);
end;
end;
end;
procedure ResolveINHERITED;
begin
// for example: inherited A;
if not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier]) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end;
// ToDo: 'inherited' keyword
// this is a quick hack: Just ignore the current class and start
// searching in the ancestor
// find ancestor of class of method
ProcNode:=Result.Node;
while (ProcNode<>nil) do begin
if not (ProcNode.Desc in [ctnProcedure,ctnProcedureHead,ctnBeginBlock,
ctnAsmBlock,ctnWithVariable,ctnWithStatement,ctnCaseBlock,
ctnCaseVariable,ctnCaseStatement]) then
begin
break;
end;
if ProcNode.Desc=ctnProcedure then begin
Result.Tool.FindClassOfMethod(ProcNode,Params,true);
// find class ancestor
Params.NewCodeTool.FindAncestorOfClass(Params.NewNode,Params,true);
Result:=CreateFindContext(Params);
exit;
end;
ProcNode:=ProcNode.Parent;
end;
MoveCursorToCleanPos(CurAtom.StartPos);
RaiseException(ctsInheritedKeywordOnlyAllowedInMethods);
end;
// TFindDeclarationTool.FindContextNodeAtCursor
begin
// start parsing the expression from right to left
NextAtom:=CurPos;
NextAtomType:=GetCurrentAtomType;
ReadPriorAtom;
CurAtom:=CurPos;
CurAtomType:=GetCurrentAtomType;
ReadCurrentAndPriorAtom;
{$IFDEF CTDEBUG}
write('[TFindDeclarationTool.FindContextNodeAtCursor] A ',
write('[TFindDeclarationTool.FindContextNodeAtCursor] <<< Right->Left ',
' Context=',Params.ContextNode.DescAsString,
' CurAtom=',AtomTypeNames[CurAtomType],
' "',copy(Src,CurAtom.StartPos,CurAtom.EndPos-CurAtom.StartPos),'"',
@ -1571,27 +1939,7 @@ begin
);
writeln('');
{$ENDIF}
if CurAtom.StartPos<Params.ContextNode.StartPos then begin
// this is the start of the variable
Result:=CreateFindContext(Self,Params.ContextNode);
exit;
end;
if (not (CurAtomType in [atIdentifier,atPreDefIdentifier,atPoint,atUp,
atEdgedBracketClose,atRoundBracketClose]))
or ((CurAtomType in [atIdentifier,atPreDefIdentifier,atNone])
and (NextAtomType in [atIdentifier,atPreDefIdentifier]))
then begin
// the next atom is the start of the variable
if (not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier,
atRoundBracketOpen,atEdgedBracketOpen,atAddrOp])) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end;
Result:=CreateFindContext(Self,Params.ContextNode);
exit;
end;
if IsStartOfVariable(Result) then exit;
// skip bracket content
if (CurAtomType in [atRoundBracketClose,atEdgedBracketClose]) then begin
@ -1607,7 +1955,7 @@ begin
// now the parsing goes from left to right
{$IFDEF CTDEBUG}
write('[TFindDeclarationTool.FindContextNodeAtCursor] B ',
write('[TFindDeclarationTool.FindContextNodeAtCursor] >>> Left->Right ',
' Context=',Params.ContextNode.DescAsString,
' CurAtom=',AtomTypeNames[CurAtomType],
' "',copy(Src,CurAtom.StartPos,CurAtom.EndPos-CurAtom.StartPos),'"',
@ -1618,324 +1966,13 @@ begin
{$ENDIF}
case CurAtomType of
atIdentifier, atPreDefIdentifier:
begin
// for example 'AnObject[3]'
if not (NextAtomType in [atSpace,atPoint,atUp,atAS,atRoundBracketOpen,
atRoundBracketClose,atEdgedBracketOpen,atEdgedBracketClose]) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
if (Result.Node=Params.ContextNode) then begin
if CompareSrcIdentifier(CurAtom.StartPos,'SELF') then begin
// SELF in a method is the object itself
// -> check if in a proc
ProcNode:=Params.ContextNode;
while (ProcNode<>nil) do begin
if (ProcNode.Desc=ctnProcedure) then begin
// in a proc -> find the class context
if Result.Tool.FindClassOfMethod(ProcNode,Params,true) then begin
Result:=CreateFindContext(Params);
exit;
end;
end;
ProcNode:=ProcNode.Parent;
end;
end else if CompareSrcIdentifier(CurAtom.StartPos,'RESULT') then begin
// RESULT has a special meaning in a function
// -> check if in a function
ProcNode:=Params.ContextNode;
while (ProcNode<>nil) do begin
if (ProcNode.Desc=ctnProcedure) then begin
Params.Save(OldInput);
Include(Params.Flags,fdfFunctionResult);
Result:=Result.Tool.FindBaseTypeOfNode(Params,ProcNode);
Params.Load(OldInput);
exit;
end;
ProcNode:=ProcNode.Parent;
end;
end;
end;
{ ToDo: check, if this is needed for Delphi:
if (NextAtomType in [atSpace])
and CompareSrcIdentifier(CurAtom.StartPos,'FREE')
and ((Result.Node.Desc=ctnClass) or NodeIsInAMethod(Result.Node)) then
begin
// FREE calls the destructor of an object
Params.Save(OldInput);
Params.SetIdentifier(Self,'DESTRUCTOR',nil);
Exclude(Params.Flags,fdfExceptionOnNotFound);
if Result.Tool.FindIdentifierInContext(Params) then begin
Result:=CreateFindContext(Params);
exit;
end;
Params.Load(OldInput);
end;}
// find sub identifier
Params.Save(OldInput);
try
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound]
+fdfAllClassVisibilities
+(fdfGlobals*Params.Flags);
if CurAtomType=atPreDefIdentifier then
Exclude(Params.Flags,fdfExceptionOnNotFound);
if Result.Node=Params.ContextNode then begin
// there is no special context -> also search in parent contexts
Params.Flags:=Params.Flags
+[fdfSearchInParentNodes,fdfIgnoreCurContextNode];
end else
// special context
Params.ContextNode:=Result.Node;
Params.SetIdentifier(Self,@Src[CurAtom.StartPos],@CheckSrcIdentifier);
if Result.Tool.FindIdentifierInContext(Params) then begin
Result:=CreateFindContext(Params);
end else begin
// predefined identifier not redefined
Result:=CreateFindContext(Self,nil);
end;
// ToDo: check if identifier in 'Protected' section
finally
Params.Load(OldInput);
end;
if Result.Node<>nil then begin
if (Result.Node<>nil)
and (Result.Node.Desc in [ctnProcedure,ctnProcedureHead]) then begin
Result.Tool.BuildSubTreeForProcHead(Result.Node,FuncResultNode);
if FuncResultNode<>nil then begin
// this is function
if (NextAtomType in [atSpace,atRoundBracketClose]) then begin
// In Delphi Mode or if there is a @ qualifier return the
// function and not the result type
// ToDo:
end;
// Otherwise return the result type
Include(Params.Flags,fdfFunctionResult);
end;
end;
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node);
end;
end;
atPoint:
begin
// for example 'A.B'
if Result.Node=Params.ContextNode then begin
MoveCursorToCleanPos(CurAtom.StartPos);
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,'.']);
end;
if (not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier])) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end;
if (Result.Node.Desc in AllUsableSourceTypes) then begin
// identifier in front of the point is a unit name
if Result.Tool<>Self then begin
Result.Node:=Result.Tool.GetInterfaceNode;
end else begin
Result:=CreateFindContext(Self,Params.ContextNode);
end;
end;
// there is no special left to do, since Result already points to
// the type context node.
end;
atAS:
begin
// for example 'A as B'
if (not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier])) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end;
// 'as' is a type cast, so the left side is irrelevant and was already
// ignored in the code at the start of this proc
// -> context is default context
end;
atUP:
begin
// for example:
// 1. 'PInt = ^integer' pointer type
// 2. a^ dereferencing
if not (NextAtomType in [atSpace,atPoint,atUp,atAS,atEdgedBracketOpen])
then begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
if Result.Node<>Params.ContextNode then begin
// left side of expression has defined a special context
// => this '^' is a dereference
if (not (NextAtomType in [atSpace,atPoint,atAS,atUP,atEdgedBracketOpen]))
then begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,['.',GetAtom]);
end;
if Result.Node.Desc<>ctnPointerType then begin
MoveCursorToCleanPos(CurAtom.StartPos);
RaiseExceptionFmt(ctsIllegalQualifier,['^']);
end;
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild);
end else if NodeHasParentOfType(Result.Node,ctnPointerType) then begin
//end else if Result.Node.Parent.Desc=ctnPointerType then begin
// this is a pointer type definition
// -> the default context is ok
end;
end;
atEdgedBracketClose:
begin
{ for example: a[]
this could be:
1. ranged array
2. dynamic array
3. indexed pointer
4. default property
5. indexed property
6. string character
}
if not (NextAtomType in [atSpace,atPoint,atAs,atUp,atRoundBracketClose,
atRoundBracketOpen,atEdgedBracketClose,atEdgedBracketOpen]) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
if Result.Node<>Params.ContextNode then begin
case Result.Node.Desc of
ctnArrayType:
// the array type is the last child node
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.LastChild);
ctnPointerType:
// the pointer type is the only child node
Result:=Result.Tool.FindBaseTypeOfNode(Params,Result.Node.FirstChild);
ctnClass:
begin
// search default property in class
Params.Save(OldInput);
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound]
+fdfGlobals*Params.Flags
+fdfAllClassVisibilities*Params.Flags;
// special identifier for default property
Params.SetIdentifier(Self,'[',nil);
Params.ContextNode:=Result.Node;
Result.Tool.FindIdentifierInContext(Params);
Result:=Params.NewCodeTool.FindBaseTypeOfNode(
Params,Params.NewNode);
Params.Load(OldInput);
end;
ctnIdentifier:
begin
MoveCursorToNodeStart(Result.Node);
ReadNextAtom;
if UpAtomIs('STRING') or UpAtomIs('ANSISTRING')
or UpAtomIs('SHORTSTRING') then begin
if not (fdfNoExceptionOnStringChar in Params.Flags) then begin
MoveCursorToCleanPos(CurAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
end;
end;
ctnProperty:
begin
// indexed property without base type
// => property type is predefined
// -> completed
end;
else
MoveCursorToCleanPos(CurAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
end;
end;
atRoundBracketClose:
begin
{ for example:
(a+b) expression bracket: the type is the result type of the
expression.
a() typecast or function
}
if not (NextAtomType in [atSpace,atPoint,atAs,atUp,atRoundBracketClose,
atRoundBracketOpen,atEdgedBracketClose,atEdgedBracketOpen]) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsIllegalQualifier,[GetAtom]);
end;
if Result.Node<>Params.ContextNode then begin
// typecast or function
end else begin
// expression
ExprType:=FindExpressionResultType(Params,CurAtom.StartPos+1,
CurAtom.EndPos-1);
if (ExprType.Context.Node=nil) then begin
MoveCursorToCleanPos(CurAtom.StartPos);
ReadNextAtom;
RaiseException(ctsExprTypeIsNotVariable);
end;
end;
end;
atINHERITED:
begin
// for example: inherited A;
if not (NextAtomType in [atSpace,atIdentifier,atPreDefIdentifier]) then
begin
MoveCursorToCleanPos(NextAtom.StartPos);
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end;
// ToDo: 'inherited' keyword
// this is a quick hack: Just ignore the current class and start
// searching in the ancestor
// find ancestor of class of method
ProcNode:=Result.Node;
while (ProcNode<>nil) do begin
if not (ProcNode.Desc in [ctnProcedure,ctnProcedureHead,ctnBeginBlock,
ctnAsmBlock,ctnWithVariable,ctnWithStatement,ctnCaseBlock,
ctnCaseVariable,ctnCaseStatement]) then
begin
break;
end;
if ProcNode.Desc=ctnProcedure then begin
Result.Tool.FindClassOfMethod(ProcNode,Params,true);
// find class ancestor
Params.NewCodeTool.FindAncestorOfClass(Params.NewNode,Params,true);
Result:=CreateFindContext(Params);
exit;
end;
ProcNode:=ProcNode.Parent;
end;
MoveCursorToCleanPos(CurAtom.StartPos);
RaiseException(ctsInheritedKeywordOnlyAllowedInMethods);
end;
atIdentifier, atPreDefIdentifier: ResolveIdentifier;
atPoint: ResolvePoint;
atAS: ResolveAs;
atUP: ResolveUp;
atEdgedBracketClose: ResolveEdgedBracketClose;
atRoundBracketClose: ResolveRoundBracketClose;
atINHERITED: ResolveINHERITED;
else
// expression start found
begin
@ -1946,6 +1983,7 @@ begin
ReadNextAtom;
RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsIdentifier,GetAtom]);
end;
Result:=CreateFindContext(Self,Params.ContextNode);
end;
end;
@ -3076,7 +3114,8 @@ begin
if not AtomIsChar('.') then continue;
Result:=true;
exit;
end;
end else
Node:=Node.Parent;
end;
end;
@ -4058,6 +4097,60 @@ begin
inherited DoDeleteNodes;
end;
function TFindDeclarationTool.NodeCacheGlobalWriteLockStepDidNotChange: boolean;
// checks if a node cache check is in the same GlobalWriteLockStep
// returns true if _no_ update is needed
// returns false, if further checks are needed
var
GlobalWriteLockIsSet: boolean;
GlobalWriteLockStep: integer;
begin
if Assigned(OnGetGlobalWriteLockInfo) then begin
OnGetGlobalWriteLockInfo(GlobalWriteLockIsSet,GlobalWriteLockStep);
if GlobalWriteLockIsSet then begin
// The global write lock is set. That means, input variables and code
// are frozen for all codetools and scanners, and therefore also for all
// node caches
if (FLastNodeCachesGlobalWriteLockStep=GlobalWriteLockStep) then begin
// source and values did not change since last NodeCache check
Result:=true;
exit;
end else begin
// this is the first check in this GlobalWriteLockStep
FLastNodeCachesGlobalWriteLockStep:=GlobalWriteLockStep;
// proceed normally ...
end;
end;
end;
Result:=false;
end;
function TFindDeclarationTool.CheckDependsOnNodeCaches: boolean;
var
ANode: TAVLTreeNode;
ATool: TFindDeclarationTool;
begin
Result:=false;
if (FDependsOnCodeTools=nil) or FCheckingNodeCacheDependencies
or NodeCacheGlobalWriteLockStepDidNotChange
then exit;
FCheckingNodeCacheDependencies:=true;
try
ANode:=FDependsOnCodeTools.FindLowest;
while ANode<>nil do begin
ATool:=TFindDeclarationTool(ANode.Data);
Result:=ATool.CheckDependsOnNodeCaches;
if Result then exit;
ANode:=FDependsOnCodeTools.FindSuccessor(ANode);
end;
Result:=UpdateNeeded(Scanner.ScanTillInterfaceEnd);
finally
FCheckingNodeCacheDependencies:=false;
if Result then ClearNodeCaches(true);
end;
end;
destructor TFindDeclarationTool.Destroy;
begin
FInterfaceIdentifierCache.Free;
@ -4076,29 +4169,15 @@ var
GlobalWriteLockStep: integer;
BaseTypeCache: TBaseTypeCache;
begin
// clear dependent codetools
ClearDependentNodeCaches;
ClearDependsOnToolRelationships;
// check if there is something cached
// check if there is something in cache to delete
if (FFirstNodeCache=nil) and (FFirstBaseTypeCache=nil)
and (FRootNodeCache=nil) then
exit;
// quick check: check if in the same GlobalWriteLockStep
if (not Force) and Assigned(OnGetGlobalWriteLockInfo) then begin
OnGetGlobalWriteLockInfo(GlobalWriteLockIsSet,GlobalWriteLockStep);
if GlobalWriteLockIsSet then begin
// The global write lock is set. That means, input variables and code
// are frozen
if (FLastNodeCachesGlobalWriteLockStep=GlobalWriteLockStep) then begin
// source and values did not change since last UpdateNeeded check
exit;
end else begin
// this is the first check in this GlobalWriteLockStep
FLastNodeCachesGlobalWriteLockStep:=GlobalWriteLockStep;
// proceed normally ...
end;
end;
end;
if (not Force) and NodeCacheGlobalWriteLockStepDidNotChange then
exit;
// clear node caches
while FFirstNodeCache<>nil do begin
NodeCache:=FFirstNodeCache;
@ -4114,6 +4193,10 @@ begin
NodeCacheMemManager.DisposeNodeCache(FRootNodeCache);
FRootNodeCache:=nil;
end;
// clear dependent codetools
ClearDependentNodeCaches;
ClearDependsOnToolRelationships;
end;
procedure TFindDeclarationTool.ClearDependentNodeCaches;
@ -4128,6 +4211,7 @@ begin
while ANode<>nil do begin
ATool:=TFindDeclarationTool(ANode.Data);
ATool.ClearNodeCaches(true);
FDependsOnCodeTools.Remove(ATool);
ANode:=FDependentCodeTools.FindSuccessor(ANode);
end;
FDependentCodeTools.Clear;

13
components/codetools/linkscanner.pas
View File

@ -62,7 +62,8 @@ type
of object;
TOnGetFileName = function(Sender: TObject; Code: Pointer): string of object;
TOnCheckFileOnDisk = function(Code: Pointer): boolean of object;
TOnGetInitValues = function(Code: Pointer): TExpressionEvaluator of object;
TOnGetInitValues = function(Code: Pointer;
var ChangeStep: integer): TExpressionEvaluator of object;
TOnIncludeCode = procedure(ParentCode, IncludeCode: Pointer) of object;
TOnSetWriteLock = procedure(Lock: boolean) of object;
TOnGetWriteLockInfo = procedure(var WriteLockIsSet: boolean;
@ -124,6 +125,7 @@ type
FOnGetInitValues: TOnGetInitValues;
FOnIncludeCode: TOnIncludeCode;
FInitValues: TExpressionEvaluator;
FInitValuesChangeStep: integer;
FSourceChangeSteps: TList; // list of PSourceChangeStep sorted with Code
FChangeStep: integer;
FMainSourceFilename: string;
@ -785,7 +787,7 @@ begin
IfLevel:=0;
FSkippingTillEndif:=false;
if Assigned(FOnGetInitValues) then
FInitValues.Assign(FOnGetInitValues(FMainCode));
FInitValues.Assign(FOnGetInitValues(FMainCode,FInitValuesChangeStep));
//writeln('TLinkScanner.Scan C --------');
Values.Assign(FInitValues);
for cm:=Low(TCompilerMode) to High(TCompilerMode) do
@ -1051,6 +1053,7 @@ var i: integer;
NewInitValues: TExpressionEvaluator;
GlobalWriteLockIsSet: boolean;
GlobalWriteLockStep: integer;
NewInitValuesChangeStep: integer;
begin
Result:=true;
if FForceUpdateNeeded then exit;
@ -1104,8 +1107,10 @@ begin
// check initvalues
if Assigned(FOnGetInitValues) then begin
if FInitValues=nil then exit;
NewInitValues:=FOnGetInitValues(Code);
if (NewInitValues<>nil) and (not FInitValues.Equals(NewInitValues)) then
NewInitValues:=FOnGetInitValues(Code,NewInitValuesChangeStep);
if (NewInitValues<>nil)
and (NewInitValuesChangeStep<>FInitValuesChangeStep)
and (not FInitValues.Equals(NewInitValues)) then
exit;
end;

59
components/codetools/stdcodetools.pas
View File

@ -287,25 +287,28 @@ function TStandardCodeTool.RenameUsedUnit(const OldUpperUnitName,
NewUnitName, NewUnitInFile: string;
SourceChangeCache: TSourceChangeCache): boolean;
var UnitPos, InPos: TAtomPosition;
NewUnitTerm: string;
NewUsesTerm: string;
begin
Result:=false;
if (OldUpperUnitName='') or (length(OldUpperUnitName)>255) or (NewUnitName='')
or (length(NewUnitName)>255) then exit;
if not FindUnitInAllUsesSections(OldUpperUnitName,UnitPos,InPos) then exit;
SourceChangeCache.MainScanner:=Scanner;
if InPos.StartPos>0 then UnitPos.EndPos:=InPos.EndPos;
NewUnitTerm:=NewUnitName;
if InPos.StartPos>0 then
UnitPos.EndPos:=InPos.EndPos;
// build use unit term
NewUsesTerm:=NewUnitName;
if NewUnitInFile<>'' then
NewUnitTerm:=NewUnitTerm+' in '''+NewUnitInFile+'''';
NewUsesTerm:=NewUsesTerm+' in '''+NewUnitInFile+'''';
//
if ReplacementNeedsLineEnd(Src,UnitPos.StartPos,UnitPos.EndPos,
length(NewUnitTerm),SourceChangeCache.BeautifyCodeOptions.LineLength) then
length(NewUsesTerm),SourceChangeCache.BeautifyCodeOptions.LineLength) then
begin
if not SourceChangeCache.Replace(gtNewLine,gtNone,
UnitPos.StartPos,UnitPos.EndPos,NewUnitTerm) then exit;
UnitPos.StartPos,UnitPos.EndPos,NewUsesTerm) then exit;
end else begin
if not SourceChangeCache.Replace(gtSpace,gtNone,
UnitPos.StartPos,UnitPos.EndPos,NewUnitTerm) then exit;
UnitPos.StartPos,UnitPos.EndPos,NewUsesTerm) then exit;
end;
if not SourceChangeCache.Apply then exit;
Result:=true;
@ -315,31 +318,33 @@ function TStandardCodeTool.AddUnitToUsesSection(UsesNode: TCodeTreeNode;
const NewUnitName, NewUnitInFile: string;
SourceChangeCache: TSourceChangeCache): boolean;
var LineStart, LineEnd, Indent, InsertPos: integer;
NewUnitTerm: string;
NewUsesTerm: string;
begin
Result:=false;
if (UsesNode=nil) or (UsesNode.Desc<>ctnUsesSection) or (NewUnitName='')
or (length(NewUnitName)>255) or (UsesNode.StartPos<1)
or (UsesNode.EndPos<1) then exit;
SourceChangeCache.MainScanner:=Scanner;
MoveCursorToNodeStart(UsesNode);
ReadNextAtom; // read first name
Indent:=GetLineIndent(Src,CurPos.StartPos);
if Indent<SourceChangeCache.BeautifyCodeOptions.Indent then
Indent:=SourceChangeCache.BeautifyCodeOptions.Indent;
InsertPos:=UsesNode.EndPos-1;
NewUnitTerm:=NewUnitName;
MoveCursorToNodeStart(UsesNode); // for nice error position
InsertPos:=UsesNode.EndPos-1; // position of semicolon
NewUsesTerm:=NewUnitName;
if NewUnitInFile<>'' then
NewUnitTerm:=NewUnitTerm+' in '''+NewUnitInFile+'''';
NewUsesTerm:=NewUsesTerm+' in '''+NewUnitInFile+'''';
GetLineStartEndAtPosition(Src,InsertPos,LineStart,LineEnd);
if InsertPos-LineStart+length(NewUnitTerm)+2>=
SourceChangeCache.BeautifyCodeOptions.LineLength then begin
NewUnitTerm:=','+SourceChangeCache.BeautifyCodeOptions.LineEnd+
GetIndentStr(Indent)+NewUnitTerm;
if InsertPos-LineStart+length(NewUsesTerm)+2>=
SourceChangeCache.BeautifyCodeOptions.LineLength then
begin
// split line
Indent:=GetLineIndent(Src,CurPos.StartPos);
if UsesNode.StartPos=LineStart then
inc(Indent,SourceChangeCache.BeautifyCodeOptions.Indent);
NewUsesTerm:=','+SourceChangeCache.BeautifyCodeOptions.LineEnd+
GetIndentStr(Indent)+NewUsesTerm;
end else
NewUnitTerm:=', '+NewUnitTerm;
// simply insert
NewUsesTerm:=', '+NewUsesTerm;
if not SourceChangeCache.Replace(gtNone,gtNone,InsertPos,InsertPos,
NewUnitTerm) then exit;
NewUsesTerm) then exit;
if not SourceChangeCache.Apply then exit;
Result:=true;
end;
@ -347,7 +352,7 @@ end;
function TStandardCodeTool.AddUnitToMainUsesSection(const NewUnitName,
NewUnitInFile: string; SourceChangeCache: TSourceChangeCache): boolean;
var UsesNode, SectionNode: TCodeTreeNode;
NewUnitTerm: string;
NewUsesTerm: string;
InsertPos: integer;
Junk : TAtomPosition;
begin
@ -375,15 +380,15 @@ begin
MoveCursorToNodeStart(SectionNode);
ReadNextAtom;
end;
NewUnitTerm:=SourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('uses')
NewUsesTerm:=SourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('uses')
+' '+NewUnitName;
if NewUnitInFile<>'' then
NewUnitTerm:=NewUnitTerm+' in '''+NewUnitInFile+''';'
NewUsesTerm:=NewUsesTerm+' in '''+NewUnitInFile+''';'
else
NewUnitTerm:=NewUnitTerm+';';
NewUsesTerm:=NewUsesTerm+';';
InsertPos:=CurPos.EndPos;
if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
NewUnitTerm) then exit;
NewUsesTerm) then exit;
if not SourceChangeCache.Apply then exit;
Result:=true;
end;

18
components/synedit/syneditautocomplete.pp
View File

@ -233,7 +233,7 @@ end;
procedure TCustomSynAutoComplete.ExecuteCompletion(AToken: string;
AEditor: TCustomSynEdit);
var
i, j, Len, IndentLen: integer;
i, j, Len, IndentLen, TokenStartX: integer;
s: string;
IdxMaybe, NumMaybe: integer;
p: TPoint;
@ -289,14 +289,17 @@ begin
{begin} //mh 2000-11-08
AEditor.BeginUpdate;
try
AEditor.BlockBegin := Point(p.x - Len, p.y);
{$IFDEF SYN_LAZARUS}
TokenStartX:=p.x;
s:=AEditor.Lines[p.y-1];
while (TokenStartX > 1) and (s[TokenStartX-1] > ' ')
and (Pos(s[TokenStartX-1], fEOTokenChars) = 0) do
Dec(TokenStartX);
AEditor.BlockBegin := Point(TokenStartX, p.y);
AEditor.BlockEnd := p;
// indent the completion string if necessary, determine the caret pos
{$IFDEF SYN_LAZARUS}
if IndentToTokenStart then begin
{$ENDIF}
IndentLen := p.x - Len - 1;
{$IFDEF SYN_LAZARUS}
end else begin
// indent as line of token
IndentLen:=1;
@ -306,6 +309,11 @@ begin
end;
dec(IndentLen);
end;
{$ELSE}
AEditor.BlockBegin := Point(p.x - Len, p.y);
AEditor.BlockEnd := p;
// indent the completion string if necessary, determine the caret pos
IndentLen := p.x - Len - 1;
{$ENDIF}
p := AEditor.BlockBegin;
NewCaretPos := FALSE;

6
ide/codetoolsdefines.pas
View File

@ -829,9 +829,9 @@ begin
FileTitles[0]:='compiler path';
FileDescs[0]:='The path to the free pascal compiler.'#13
+'For example /usr/bin/ppc386 or /usr/local/bin/fpc.';
+'For example "/usr/bin/ppc386 -n" or "/usr/local/bin/fpc @/etc/11fpc.cfg".';
FileNames[0]:=DefaultCompiler;
FileFlags[0]:=[iftFilename,iftNotEmpty,iftMustExist];
FileFlags[0]:=[iftCmdLine,iftNotEmpty];
EndUpdate;
if ShowModal=mrCancel then exit;
@ -1826,7 +1826,7 @@ end;
procedure TCodeToolsDefinesEditor.SetValuesEditable(AValue: boolean);
begin
SelectedItemGroupBox.Enabled:=true;
TypeLabel.Enabled:=AValue;
TypeLabel.Enabled:=true;
ProjectSpecificCheckBox.Enabled:=AValue;
NameLabel.Enabled:=AValue;
NameEdit.Enabled:=AValue;

59
ide/compileroptions.pp
View File

@ -208,6 +208,27 @@ type
nbMain: TNotebook;
//bvlButtonBar: TBevel;
{ Search Paths Controls }
grpOtherUnits: TGroupBox;
edtOtherUnits: TEdit;
grpIncludeFiles: TGroupBox;
edtIncludeFiles: TEdit;
grpOtherSources: TGroupBox;
edtOtherSources: TEdit;
grpLibraries: TGroupBox;
edtLibraries: TEdit;
grpCompiler: TGroupBox;
edtCompiler: TEdit;
grpUnitOutputDir: TGroupBox;
edtUnitOutputDir: TEdit;
LCLWidgetTypeRadioGroup: TRadioGroup;
{ Parsing Controls }
grpStyle: TGroupBox;
radStyleIntel: TRadioButton;
@ -303,35 +324,12 @@ type
grpErrorCnt: TGroupBox;
edtErrorCnt: TEdit;
{ Search Paths Controls }
grpOtherUnits: TGroupBox;
edtOtherUnits: TEdit;
grpIncludeFiles: TGroupBox;
edtIncludeFiles: TEdit;
grpOtherSources: TGroupBox;
edtOtherSources: TEdit;
grpLibraries: TGroupBox;
edtLibraries: TEdit;
grpCompiler: TGroupBox;
edtCompiler: TEdit;
grpUnitOutputDir: TGroupBox;
edtUnitOutputDir: TEdit;
LCLWidgetTypeRadioGroup: TRadioGroup;
{ Buttons }
btnTest: TButton;
btnOK: TButton;
btnCancel: TButton;
btnApply: TButton;
function GetOtherSourcePath: string;
procedure SetOtherSourcePath(const AValue: string);
{ Other variables }
// fPath: String;
@ -343,6 +341,10 @@ type
procedure SetupOtherTab(Sender: TObject; Page: integer);
procedure SetupSearchPathsTab(Sender: TObject; Page: integer);
procedure SetupButtonBar(Sender: TObject);
procedure chkAdditionalConfigFileClick(Sender: TObject);
private
function GetOtherSourcePath: string;
procedure SetOtherSourcePath(const AValue: string);
public
CompilerOpts: TCompilerOptions;
@ -1553,7 +1555,8 @@ begin
chkCompiledProc.Checked := CompilerOpts.ShowCompProc;
chkConditionals.Checked := CompilerOpts.ShowCond;
chkNothing.Checked := CompilerOpts.ShowNothing;
chkHintsForUnusedProjectUnits.Checked := CompilerOpts.ShowHintsForUnusedProjectUnits;
chkHintsForUnusedProjectUnits.Checked :=
CompilerOpts.ShowHintsForUnusedProjectUnits;
chkFPCLogo.Checked := CompilerOpts.WriteFPCLogo;
@ -2638,6 +2641,7 @@ begin
Left := 8;
Height := 16;
Width := 330;
OnClick:=@chkAdditionalConfigFileClick;
Visible := True;
end;
@ -2924,6 +2928,11 @@ begin
end;
end;
procedure TfrmCompilerOptions.chkAdditionalConfigFileClick(Sender: TObject);
begin
edtConfigPath.Enabled:=chkAdditionalConfigFile.Checked;
end;
function TfrmCompilerOptions.GetOtherSourcePath: string;
begin
Result:=edtOtherSources.Text;

2
ide/editdefinetree.pas
View File

@ -177,7 +177,7 @@ begin
da_DefineRecurse));
end;
// source path (unitpath + sources for the CodeTools, hidden to the compiler)
if s<>'' then begin
if (SrcPath<>'') or (s<>'') then begin
// add compiled unit path
ProjTempl.AddChild(TDefineTemplate.Create('SrcPath',
'source path addition',ExternalMacroStart+'SrcPath',

6
ide/inputfiledialog.pas
View File

@ -22,7 +22,8 @@ uses
LResources, TransferMacros;
type
TInputFileFlag = (iftDirectory, iftFilename, iftNotEmpty, iftMustExist);
TInputFileFlag = (iftDirectory, iftFilename, iftCmdLine,
iftNotEmpty, iftMustExist);
TInputFileFlags = set of TInputFileFlag;
TInputFileDialog = class(TForm)
@ -259,7 +260,8 @@ begin
Result:=false;
CurFileFlags:=FileFlags[Index];
if (iftNotEmpty in CurFileFlags) and (Filename='') then exit;
if (iftMustExist in CurFileFlags) and (Filename<>'') then begin
if ([iftMustExist,iftCmdLine]*CurFileFlags=[iftMustExist])
and (Filename<>'') then begin
if FTransferMacros<>nil then
Macros.SubstituteStr(Filename);
Filename:=ExpandFileName(Filename);

43
ide/main.pp
View File

@ -5405,10 +5405,10 @@ var ActiveSrcEdit: TSourceEditor;
NewX, NewY, NewTopLine: integer;
begin
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit;
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoJumpToProcedureSection] ************');
{$ENDIF}
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoJumpToProcedureSection] ************');
{$ENDIF}
if CodeToolBoss.JumpToMethod(ActiveUnitInfo.Source,
ActiveSrcEdit.EditorComponent.CaretX,
ActiveSrcEdit.EditorComponent.CaretY,
@ -5468,10 +5468,10 @@ var ActiveSrcEdit: TSourceEditor;
NewX, NewY, NewTopLine: integer;
begin
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit;
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoFindDeclarationAtCursor] ************');
{$ENDIF}
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoFindDeclarationAtCursor] ************');
{$ENDIF}
if CodeToolBoss.FindDeclaration(ActiveUnitInfo.Source,
ActiveSrcEdit.EditorComponent.CaretX,
ActiveSrcEdit.EditorComponent.CaretY,
@ -5490,10 +5490,10 @@ var ActiveSrcEdit: TSourceEditor;
NewX, NewY, NewTopLine: integer;
begin
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit;
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoGoToPascalBlockOtherEnd] ************');
{$ENDIF}
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoGoToPascalBlockOtherEnd] ************');
{$ENDIF}
if CodeToolBoss.FindBlockCounterPart(ActiveUnitInfo.Source,
ActiveSrcEdit.EditorComponent.CaretX,
ActiveSrcEdit.EditorComponent.CaretY,
@ -5512,10 +5512,10 @@ var ActiveSrcEdit: TSourceEditor;
NewX, NewY, NewTopLine: integer;
begin
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit;
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoGoToPascalBlockStart] ************');
{$ENDIF}
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoGoToPascalBlockStart] ************');
{$ENDIF}
if CodeToolBoss.FindBlockStart(ActiveUnitInfo.Source,
ActiveSrcEdit.EditorComponent.CaretX,
ActiveSrcEdit.EditorComponent.CaretY,
@ -5534,10 +5534,10 @@ var ActiveSrcEdit: TSourceEditor;
StartX, StartY, NewX, NewY, NewTopLine: integer;
begin
if not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,false) then exit;
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoGoToPascalBlockEnd] ************');
{$ENDIF}
{$IFDEF IDE_DEBUG}
writeln('');
writeln('[TMainIDE.DoGoToPascalBlockEnd] ************');
{$ENDIF}
if FindNext then begin
StartX:=ActiveSrcEdit.EditorComponent.CaretX;
StartY:=ActiveSrcEdit.EditorComponent.CaretY;
@ -6203,6 +6203,9 @@ end.
{ =============================================================================
$Log$
Revision 1.275 2002/04/11 08:08:47 lazarus
MG: small fixes, cleanups and started event assignment completion
Revision 1.274 2002/04/06 11:20:41 lazarus
MG: added fpc define templates

2
ide/uniteditor.pp
View File

@ -1644,7 +1644,7 @@ begin
AutoCompleteList.LoadFromFile('lazarus.dci');
IndentToTokenStart:=EditorOpts.CodeTemplateIndentToTokenStart;
OnTokenNotFound:=@OnCodeTemplateTokenNotFound;
EndOfTokenChr:='[]{},.;:"+-*^@$\<>=''';
EndOfTokenChr:='()[]{},.;:"+-*^@$\<>=''';
end;
if aWordCompletion=nil then begin
aWordCompletion:=TWordCompletion.Create;