mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-17 08:09:26 +02:00
MG: fixed find declaration new nodecache flags, find next
git-svn-id: trunk@1481 -
This commit is contained in:
lazarus
parent
84fc508f31
commit
830cb9a016
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -118,6 +118,7 @@ ide/buildlazdialog.pas svneol=native#text/pascal
|
||||
ide/codetemplatedialog.pp svneol=native#text/pascal
|
||||
ide/codetoolsdefines.lrs svneol=native#text/pascal
|
||||
ide/codetoolsdefines.pas svneol=native#text/pascal
|
||||
ide/codetoolsdefpreview.pas svneol=native#text/pascal
|
||||
ide/codetoolsoptions.pas svneol=native#text/pascal
|
||||
ide/compiler.pp svneol=native#text/pascal
|
||||
ide/compileroptions.pp svneol=native#text/pascal
|
||||
|
||||
@ -100,7 +100,7 @@ const
|
||||
ctnPointerType = 74;
|
||||
ctnClassOfType = 75;
|
||||
ctnVariantType = 76;
|
||||
|
||||
|
||||
ctnBeginBlock = 80;
|
||||
ctnAsmBlock = 81;
|
||||
|
||||
@ -150,6 +150,7 @@ type
|
||||
function Next: TCodeTreeNode;
|
||||
function Prior: TCodeTreeNode;
|
||||
function HasAsParent(Node: TCodeTreeNode): boolean;
|
||||
function HasParentOfType(ParentDesc: TCodeTreeNodeDesc): boolean;
|
||||
function DescAsString: string;
|
||||
procedure Clear;
|
||||
constructor Create;
|
||||
@ -388,6 +389,15 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeTreeNode.HasParentOfType(ParentDesc: TCodeTreeNodeDesc): boolean;
|
||||
var ANode: TCodeTreeNode;
|
||||
begin
|
||||
ANode:=Parent;
|
||||
while (ANode<>nil) and (ANode.Desc<>ParentDesc) do
|
||||
ANode:=ANode.Parent;
|
||||
Result:=ANode<>nil;
|
||||
end;
|
||||
|
||||
function TCodeTreeNode.DescAsString: string;
|
||||
begin
|
||||
Result:=NodeDescriptionAsString(Desc);
|
||||
|
||||
@ -210,28 +210,28 @@ type
|
||||
protected
|
||||
function FindDirectoryInCache(const Path: string): TDirectoryDefines;
|
||||
public
|
||||
function GetDefinesForDirectory(const Path: string): TExpressionEvaluator;
|
||||
function GetDefinesForVirtualDirectory: TExpressionEvaluator;
|
||||
property RootTemplate: TDefineTemplate
|
||||
read FFirstDefineTemplate write FFirstDefineTemplate;
|
||||
property OnReadValue: TOnReadValue read FOnReadValue write FOnReadValue;
|
||||
property ErrorTemplate: TDefineTemplate read FErrorTemplate;
|
||||
property ErrorDescription: string read FErrorDescription;
|
||||
function GetDefinesForDirectory(const Path: string): TExpressionEvaluator;
|
||||
function GetDefinesForVirtualDirectory: TExpressionEvaluator;
|
||||
procedure AddFirst(ADefineTemplate: TDefineTemplate);
|
||||
procedure Add(ADefineTemplate: TDefineTemplate);
|
||||
function FindDefineTemplateByName(const AName: string;
|
||||
function FindDefineTemplateByName(const AName: string;
|
||||
OnlyRoots: boolean): TDefineTemplate;
|
||||
procedure ReplaceRootSameName(ADefineTemplate: TDefineTemplate);
|
||||
procedure ReplaceRootSameNameAddFirst(ADefineTemplate: TDefineTemplate);
|
||||
procedure RemoveRootDefineTemplateByName(const AName: string);
|
||||
property OnReadValue: TOnReadValue read FOnReadValue write FOnReadValue;
|
||||
property ErrorTemplate: TDefineTemplate read FErrorTemplate;
|
||||
property ErrorDescription: string read FErrorDescription;
|
||||
function LoadFromXMLConfig(XMLConfig: TXMLConfig;
|
||||
function LoadFromXMLConfig(XMLConfig: TXMLConfig;
|
||||
const Path: string; Policy: TDefineTreeLoadPolicy;
|
||||
const NewNamePrefix: string): boolean;
|
||||
function SaveToXMLConfig(XMLConfig: TXMLConfig;
|
||||
function SaveToXMLConfig(XMLConfig: TXMLConfig;
|
||||
const Path: string; Policy: TDefineTreeSavePolicy): boolean;
|
||||
procedure ClearCache;
|
||||
procedure Clear;
|
||||
function IsEqual(SrcDefineTree: TDefineTree): boolean;
|
||||
function IsEqual(SrcDefineTree: TDefineTree): boolean;
|
||||
procedure Assign(SrcDefineTree: TDefineTree);
|
||||
procedure RemoveMarked;
|
||||
procedure RemoveGlobals;
|
||||
@ -240,7 +240,7 @@ type
|
||||
procedure RemoveNonAutoCreated;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function ConsistencyCheck: integer; // 0 = ok
|
||||
function ConsistencyCheck: integer; // 0 = ok
|
||||
procedure WriteDebugReport;
|
||||
end;
|
||||
|
||||
@ -1813,13 +1813,15 @@ function TDefinePool.CreateFPCTemplate(
|
||||
NewDefTempl:=TDefineTemplate.Create('Define '+MacroName,
|
||||
'Default ppc386 macro',MacroName,'',da_DefineRecurse);
|
||||
end else if copy(UpLine,1,6)='MACRO ' then begin
|
||||
Line:=copy(Line,7,length(Line)-6);
|
||||
System.Delete(Line,1,6);
|
||||
System.Delete(UpLine,1,6);
|
||||
i:=1;
|
||||
while (i<=length(Line)) and (Line[i]<>' ') do inc(i);
|
||||
MacroName:=copy(UpLine,1,i-1);
|
||||
inc(i);
|
||||
Line:=copy(Line,i,length(Line)-i+1);
|
||||
if copy(Line,1,7)='set to ' then begin
|
||||
System.Delete(Line,1,i-1);
|
||||
System.Delete(UpLine,1,i-1);
|
||||
if copy(UpLine,1,7)='SET TO ' then begin
|
||||
MacroValue:=copy(Line,8,length(Line)-7);
|
||||
NewDefTempl:=TDefineTemplate.Create('Define '+MacroName,
|
||||
'Default ppc386 macro',MacroName,MacroValue,da_DefineRecurse);
|
||||
|
||||
@ -70,6 +70,7 @@ type
|
||||
function Eval(const Expression:string):string;
|
||||
property ErrorPosition:integer read ErrorPos;
|
||||
property OnChange: TOnValuesChanged read FOnChange write FOnChange;
|
||||
function Items(Index: integer): string;
|
||||
procedure Clear;
|
||||
function AsString: string;
|
||||
constructor Create;
|
||||
@ -190,6 +191,11 @@ begin
|
||||
Result:=s;
|
||||
end;
|
||||
|
||||
function TExpressionEvaluator.Items(Index: integer): string;
|
||||
begin
|
||||
Result:=FNames[Index]+'='+FValues[Index];
|
||||
end;
|
||||
|
||||
function TExpressionEvaluator.EvalAtPos: string;
|
||||
var r: string; // current result
|
||||
c,o1,o2: char;
|
||||
|
||||
@ -97,7 +97,7 @@ const
|
||||
type
|
||||
TNodeCacheEntryFlag = (ncefSearchedInParents, ncefSearchedInAncestors);
|
||||
TNodeCacheEntryFlags = set of TNodeCacheEntryFlag;
|
||||
|
||||
|
||||
PCodeTreeNodeCacheEntry = ^TCodeTreeNodeCacheEntry;
|
||||
TCodeTreeNodeCacheEntry = record
|
||||
Identifier: PChar;
|
||||
@ -244,6 +244,9 @@ type
|
||||
|
||||
const
|
||||
ncefAllSearchRanges = [ncefSearchedInAncestors,ncefSearchedInParents];
|
||||
NodeCacheEntryFlagNames: array[TNodeCacheEntryFlag] of string = (
|
||||
'SearchedInParents', 'SearchedInAncestors'
|
||||
);
|
||||
|
||||
var
|
||||
GlobalIdentifierTree: TGlobalIdentifierTree;
|
||||
@ -253,10 +256,24 @@ var
|
||||
BaseTypeCacheMemManager: TBaseTypeCacheMemManager;
|
||||
|
||||
|
||||
function NodeCacheEntryFlagsAsString(Flags: TNodeCacheEntryFlags): string;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
function NodeCacheEntryFlagsAsString(Flags: TNodeCacheEntryFlags): string;
|
||||
var f: TNodeCacheEntryFlag;
|
||||
begin
|
||||
Result:='';
|
||||
for f:=Low(TNodeCacheEntryFlag) to High(TNodeCacheEntryFlag) do begin
|
||||
if f in Flags then begin
|
||||
if Result<>'' then Result:=rEsult+', ';
|
||||
Result:=Result+NodeCacheEntryFlagNames[f];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TNodeCacheEntryMemManager }
|
||||
|
||||
procedure TNodeCacheEntryMemManager.DisposeEntry(Entry: PCodeTreeNodeCacheEntry);
|
||||
@ -597,6 +614,7 @@ procedure TCodeTreeNodeCache.Add(Identifier: PChar;
|
||||
NewEntry^.NewNode:=NewNode;
|
||||
NewEntry^.NewTool:=NewTool;
|
||||
NewEntry^.NewCleanPos:=NewCleanPos;
|
||||
NewEntry^.Flags:=Flags;
|
||||
FItems.Add(NewEntry);
|
||||
end;
|
||||
|
||||
@ -635,6 +653,15 @@ begin
|
||||
if CleanStartPos>=CleanEndPos then
|
||||
raise Exception.Create('[TCodeTreeNodeCache.Add] internal error:'
|
||||
+' CleanStartPos>=CleanEndPos');
|
||||
{if GetIdentifier(Identifier)='TDefineAction' then begin
|
||||
writeln('[[[[======================================================');
|
||||
writeln('[TCodeTreeNodeCache.Add] Ident=',GetIdentifier(Identifier),
|
||||
' CleanStartPos=',CleanStartPos,' CleanEndPos=',CleanEndPos,
|
||||
' Flags=[',NodeCacheEntryFlagsAsString(Flags),']',
|
||||
' NewNode=',NewNode<>nil
|
||||
);
|
||||
writeln('======================================================]]]]');
|
||||
end;}
|
||||
if FItems=nil then
|
||||
FItems:=TAVLTree.Create(@CompareTCodeTreeNodeCacheEntry);
|
||||
// if identifier already exists, try to combine them
|
||||
@ -644,8 +671,8 @@ begin
|
||||
AddNewEntry;
|
||||
end else begin
|
||||
// identifier was already searched in this range
|
||||
NewSearchRangeFlags:=(ncefAllSearchRanges * (OldEntry^.Flags+Flags));
|
||||
OldEntry:=PCodeTreeNodeCacheEntry(OldNode.Data);
|
||||
NewSearchRangeFlags:=(ncefAllSearchRanges * (OldEntry^.Flags+Flags));
|
||||
if ((NewNode=OldEntry^.NewNode)
|
||||
and (NewTool=OldEntry^.NewTool))
|
||||
or ((OldEntry^.NewNode=nil) and (NewSearchRangeFlags<>[])) then
|
||||
@ -656,7 +683,7 @@ begin
|
||||
OldEntry^.CleanStartPos:=CleanStartPos;
|
||||
if OldEntry^.CleanEndPos<CleanEndPos then
|
||||
OldEntry^.CleanEndPos:=CleanEndPos;
|
||||
OldEntry^.Flags:=OldEntry^.Flags+NewSearchRangeFlags;
|
||||
OldEntry^.Flags:=NewSearchRangeFlags;
|
||||
end else begin
|
||||
// different FindContext with overlapping search ranges
|
||||
RaiseConflictException;
|
||||
@ -821,6 +848,8 @@ begin
|
||||
while Node<>nil do begin
|
||||
Entry:=PCodeTreeNodeCacheEntry(Node.Data);
|
||||
write(Prefix,' Ident="',GetIdentifier(Entry^.Identifier),'"');
|
||||
write(' Flags=[',NodeCacheEntryFlagsAsString(Entry^.Flags),']');
|
||||
write(' Node=',Entry^.NewNode<>nil);
|
||||
writeln('');
|
||||
Node:=FItems.FindSuccessor(Node);
|
||||
end;
|
||||
|
||||
@ -27,6 +27,15 @@
|
||||
|
||||
ToDo:
|
||||
- many things, search for 'ToDo'
|
||||
- Examples:
|
||||
- @ operator
|
||||
- 'inherited'
|
||||
- variants
|
||||
- array of const
|
||||
- interfaces
|
||||
- Get and Set property access parameter lists
|
||||
- operator overloading
|
||||
- ppu, ppw, dcu files
|
||||
|
||||
}
|
||||
unit FindDeclarationTool;
|
||||
@ -180,6 +189,7 @@ type
|
||||
Items: ^TExpressionType;
|
||||
procedure Add(ExprType: TExpressionType);
|
||||
destructor Destroy; override;
|
||||
function AsString: string;
|
||||
end;
|
||||
|
||||
|
||||
@ -951,15 +961,21 @@ var
|
||||
// cached result found
|
||||
Params.SetResult(LastCacheEntry);
|
||||
{$IFDEF ShowNodeCache}
|
||||
writeln(':::: TFindDeclarationTool.FindIdentifierInContext.FindInNodeCache');
|
||||
writeln(' Ident=',GetIdentifier(Params.Identifier),
|
||||
' ContextNode=',ContextNode.DescAsString,
|
||||
write(':::: TFindDeclarationTool.FindIdentifierInContext.FindInNodeCache');
|
||||
writeln(' Ident=',GetIdentifier(Params.Identifier),
|
||||
' Wanted=[',NodeCacheEntryFlagsAsString(NodeCacheEntryFlags),']',
|
||||
' Cache=[',NodeCacheEntryFlagsAsString(LastCacheEntry^.Flags),']'
|
||||
);
|
||||
writeln(' ContextNode=',ContextNode.DescAsString,
|
||||
' Self=',MainFilename);
|
||||
if (Params.NewNode<>nil) then
|
||||
writeln(' NewTool=',Params.NewCodeTool.MainFilename,
|
||||
' NewNode=',Params.NewNode.DescAsString)
|
||||
else
|
||||
writeln(' cache says: identifier NOT FOUND');
|
||||
if CompareSrcIdentifiers(Params.Identifier,'TDefineAction') then begin
|
||||
NodeCache.WriteDebugReport('NANUNANA: ');
|
||||
end;
|
||||
{$ENDIF}
|
||||
Result:=true;
|
||||
end;
|
||||
@ -979,7 +995,20 @@ var
|
||||
begin
|
||||
Result:=false;
|
||||
ContextNode:=Params.ContextNode;
|
||||
if ContextNode=nil then begin
|
||||
RaiseException('[TFindDeclarationTool.FindIdentifierInContext] '
|
||||
+' internal error: Params.ContextNode=nil');
|
||||
end;
|
||||
StartContextNode:=ContextNode;
|
||||
if (fdfFirstIdentFound in Params.Flags)
|
||||
and (not (fdfSearchInParentNodes in Params.Flags)) then begin
|
||||
// this is a find next call
|
||||
// -> adjust StartContextNode, so that siblings, that are not yet searched
|
||||
// are searched
|
||||
while (StartContextNode.Parent<>nil)
|
||||
and (StartContextNode.Parent.Desc in (AllClassSections+[ctnClass])) do
|
||||
StartContextNode:=StartContextNode.Parent;
|
||||
end;
|
||||
FirstSearchedNode:=nil;
|
||||
LastSearchedNode:=nil;
|
||||
SearchRangeFlags:=[];
|
||||
@ -987,10 +1016,6 @@ begin
|
||||
Include(SearchRangeFlags,ncefSearchedInParents);
|
||||
if fdfSearchInAncestors in Params.Flags then
|
||||
Include(SearchRangeFlags,ncefSearchedInAncestors);
|
||||
if ContextNode=nil then begin
|
||||
RaiseException('[TFindDeclarationTool.FindIdentifierInContext] '
|
||||
+' internal error: Params.ContextNode=nil');
|
||||
end;
|
||||
try
|
||||
LastNodeCache:=nil;
|
||||
LastCacheEntry:=nil;
|
||||
@ -1210,6 +1235,7 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] IgnoreCurContext');
|
||||
end;
|
||||
if LastContextNode=ContextNode then begin
|
||||
// same context -> search in prior context
|
||||
|
||||
if (not ContextNode.HasAsParent(StartContextNode)) then begin
|
||||
// searching in a prior node, will leave the start context
|
||||
if (not (fdfSearchInParentNodes in Params.Flags)) then begin
|
||||
@ -1470,6 +1496,11 @@ write('[TFindDeclarationTool.FindContextNodeAtCursor] A ',
|
||||
);
|
||||
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,atAs,
|
||||
atEdgedBracketClose,atRoundBracketClose,atRead,atWrite,atINHERITED])
|
||||
then begin
|
||||
@ -1490,16 +1521,17 @@ writeln('');
|
||||
ReadBackTilBracketClose(true);
|
||||
CurAtom.StartPos:=CurPos.StartPos;
|
||||
end;
|
||||
if (not (CurAtomType in [atAS,atRead,atWrite,atINHERITED]))
|
||||
and ((not (CurAtomType in [atIdentifier,atPreDefIdentifier]))
|
||||
or (not (NextAtomType in [atIdentifier,atPreDefIdentifier])))
|
||||
then
|
||||
// find prior context
|
||||
Result:=FindContextNodeAtCursor(Params)
|
||||
else
|
||||
if (CurAtomType in [atAS,atRead,atWrite,atINHERITED,atNone])
|
||||
or ((CurAtomType in [atIdentifier,atPreDefIdentifier])
|
||||
and (NextAtomType in [atIdentifier,atPreDefIdentifier]))
|
||||
then begin
|
||||
// this is the start of the variable
|
||||
Result:=CreateFindContext(Self,Params.ContextNode);
|
||||
if Result.Node=nil then exit;
|
||||
Result:=CreateFindContext(Self,Params.ContextNode)
|
||||
end else begin
|
||||
// find prior context
|
||||
Result:=FindContextNodeAtCursor(Params);
|
||||
end;
|
||||
if (Result.Node=nil) then exit;
|
||||
|
||||
// the left side has been parsed and
|
||||
// now the parsing goes from left to right
|
||||
@ -1688,6 +1720,7 @@ writeln('');
|
||||
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;
|
||||
@ -1877,7 +1910,11 @@ writeln(' Flags=[',FindDeclarationFlagsAsString(Params.Flags),']');
|
||||
{$ENDIF}
|
||||
if (Result.Node.Desc in AllIdentifierDefinitions) then begin
|
||||
// instead of variable/const/type definition, return the type
|
||||
Result.Node:=FindTypeNodeOfDefinition(Result.Node);
|
||||
DummyNode:=FindTypeNodeOfDefinition(Result.Node);
|
||||
if DummyNode=nil then
|
||||
// some constants and variants do not have a type
|
||||
break;
|
||||
Result.Node:=DummyNode;
|
||||
end else
|
||||
if (Result.Node.Desc=ctnClass)
|
||||
and ((Result.Node.SubDesc and ctnsForwardDeclaration)>0) then
|
||||
@ -3347,7 +3384,7 @@ writeln('[TFindDeclarationTool.IsParamListCompatible] ',
|
||||
{$IFDEF ShowExprEval}
|
||||
finally
|
||||
writeln('[TFindDeclarationTool.IsParamListCompatible] END ',
|
||||
' Result=',TypeCompatibilityNames[Result]
|
||||
' Result=',TypeCompatibilityNames[Result],' ! ONLY VALID if no error !'
|
||||
);
|
||||
end;
|
||||
{$ENDIF}
|
||||
@ -3430,7 +3467,6 @@ writeln('[TFindDeclarationTool.CheckSrcIdentifier]',
|
||||
CurCompatibilityList:=nil;
|
||||
end;
|
||||
try
|
||||
Include(Params.Flags,fdfFirstIdentFound);
|
||||
// check the first proc for compatibility
|
||||
CurFoundContext:=FoundContext;
|
||||
FirstParameterNode:=FoundContext.Tool.GetFirstParameterNode(
|
||||
@ -3446,7 +3482,8 @@ writeln('[TFindDeclarationTool.CheckSrcIdentifier]',
|
||||
exit;
|
||||
end;
|
||||
// search the other procs
|
||||
Params.Save(OldInput);
|
||||
Params.Load(OldInput);
|
||||
Include(Params.Flags,fdfFirstIdentFound);
|
||||
Params.SetResult(FoundContext);
|
||||
Params.ContextNode:=FoundContext.Node;
|
||||
repeat
|
||||
@ -3690,6 +3727,7 @@ writeln('[TFindDeclarationTool.CreateParamExprList] ',
|
||||
{$IFDEF ShowExprEval}
|
||||
writeln('[TFindDeclarationTool.CreateParamExprList] END ',
|
||||
'ParamCount=',Result.Count,' "',copy(Src,StartPos,40),'"');
|
||||
writeln(' ExprList=[',Result.AsString,']');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
@ -3938,30 +3976,6 @@ var Node: TCodeTreeNode;
|
||||
NewTool: TPascalParserTool;
|
||||
NewCleanPos: integer;
|
||||
begin
|
||||
{$IFDEF ShowNodeCache}
|
||||
//if CompareSrcIdentifiers(Identifier,'TDefineTree') then writeln('=================================');
|
||||
write('TFindDeclarationTool.AddResultToNodeCaches ',
|
||||
' Ident=',GetIdentifier(Identifier));
|
||||
write(' SearchedForward=',SearchedForward);
|
||||
write(' Flags=[');
|
||||
if ncefSearchedInParents in SearchRangeFlags then write('Parents');
|
||||
if ncefSearchedInAncestors in SearchRangeFlags then write(',Ancestors');
|
||||
writeln(']');
|
||||
write(' StartNode=',StartNode.DescAsString,'="',copy(Src,StartNode.StartPos-10,10),'|',copy(Src,StartNode.StartPos,15),'"');
|
||||
if EndNode<>nil then
|
||||
write(' EndNode=',EndNode.DescAsString,'="',copy(Src,EndNode.StartPos,25),'"')
|
||||
else
|
||||
write(' EndNode=nil');
|
||||
writeln('');
|
||||
writeln(' Self=',MainFilename);
|
||||
if Params<>nil then begin
|
||||
writeln(' NewNode=',Params.NewNode.DescAsString,
|
||||
' NewTool=',Params.NewCodeTool.MainFilename);
|
||||
end else begin
|
||||
writeln(' NOT FOUND');
|
||||
end;
|
||||
//if CompareSrcIdentifiers(Identifier,'TDefineTree') then writeln('=================================');
|
||||
{$ENDIF}
|
||||
Node:=StartNode;
|
||||
LastNodeCache:=nil;
|
||||
if Params<>nil then begin
|
||||
@ -3986,7 +4000,31 @@ end;
|
||||
CleanEndPos:=SrcLen+1;
|
||||
end;
|
||||
{$IFDEF ShowNodeCache}
|
||||
writeln(' CleanStartPos=',CleanStartPos,' CleanEndPos=',CleanEndPos);
|
||||
if CompareSrcIdentifiers(Identifier,'TDefineAction')
|
||||
and (ExtractFileName(MainFilename)='codetoolsdefines.pas') then begin
|
||||
writeln('(((((((((((((((((((((((((((==================');
|
||||
write('TFindDeclarationTool.AddResultToNodeCaches ',
|
||||
' Ident=',GetIdentifier(Identifier));
|
||||
write(' SearchedForward=',SearchedForward);
|
||||
write(' Flags=[');
|
||||
if ncefSearchedInParents in SearchRangeFlags then write('Parents');
|
||||
if ncefSearchedInAncestors in SearchRangeFlags then write(',Ancestors');
|
||||
writeln(']');
|
||||
write(' StartNode=',StartNode.DescAsString,'="',copy(Src,StartNode.StartPos-10,10),'|',copy(Src,StartNode.StartPos,15),'"');
|
||||
if EndNode<>nil then
|
||||
write(' EndNode=',EndNode.DescAsString,'="',copy(Src,EndNode.StartPos,25),'"')
|
||||
else
|
||||
write(' EndNode=nil');
|
||||
writeln('');
|
||||
writeln(' Self=',MainFilename);
|
||||
if Params<>nil then begin
|
||||
writeln(' NewNode=',Params.NewNode.DescAsString,
|
||||
' NewTool=',Params.NewCodeTool.MainFilename);
|
||||
end else begin
|
||||
writeln(' NOT FOUND');
|
||||
end;
|
||||
writeln(' CleanStartPos=',CleanStartPos,' CleanEndPos=',CleanEndPos);
|
||||
end;
|
||||
{$ENDIF}
|
||||
while (Node<>nil) do begin
|
||||
if (Node.Desc in AllNodeCacheDescs) then begin
|
||||
@ -3995,8 +4033,20 @@ writeln(' CleanStartPos=',CleanStartPos,' CleanEndPos=',CleanEndPos);
|
||||
if (Node.Cache is TCodeTreeNodeCache) then begin
|
||||
CurNodeCache:=TCodeTreeNodeCache(Node.Cache);
|
||||
if LastNodeCache<>CurNodeCache then begin
|
||||
{$IFDEF ShowNodeCache}
|
||||
if CompareSrcIdentifiers(Identifier,'TDefineAction')
|
||||
and (ExtractFileName(MainFilename)='codetoolsdefines.pas') then begin
|
||||
CurNodeCache.WriteDebugReport(' VORHER NODECACHE REPORT: ');
|
||||
end;
|
||||
{$ENDIF}
|
||||
CurNodeCache.Add(Identifier,CleanStartPos,CleanEndPos,
|
||||
NewNode,NewTool,NewCleanPos,SearchRangeFlags);
|
||||
{$IFDEF ShowNodeCache}
|
||||
if CompareSrcIdentifiers(Identifier,'TDefineAction')
|
||||
and (ExtractFileName(MainFilename)='codetoolsdefines.pas') then begin
|
||||
CurNodeCache.WriteDebugReport(' NACHHER NODECACHE REPORT: ');
|
||||
end;
|
||||
{$ENDIF}
|
||||
LastNodeCache:=CurNodeCache;
|
||||
end;
|
||||
end;
|
||||
@ -4004,6 +4054,12 @@ writeln(' CleanStartPos=',CleanStartPos,' CleanEndPos=',CleanEndPos);
|
||||
Node:=Node.Parent;
|
||||
if (EndNode<>nil) and (Node=EndNode.Parent) then break;
|
||||
end;
|
||||
{$IFDEF ShowNodeCache}
|
||||
if CompareSrcIdentifiers(Identifier,'TDefineAction')
|
||||
and (ExtractFileName(MainFilename)='codetoolsdefines.pas') then begin
|
||||
writeln('=========================))))))))))))))))))))))))))))))))');
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.CreateNewNodeCache(
|
||||
@ -4197,6 +4253,15 @@ begin
|
||||
if Items<>nil then FreeMem(Items);
|
||||
end;
|
||||
|
||||
function TExprTypeList.AsString: string;
|
||||
var i: integer;
|
||||
begin
|
||||
Result:='';
|
||||
for i:=0 to Count-1 do begin
|
||||
Result:=Result+'{'+ExprTypeToString(Items[i])+'}'#13#10;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TExprTypeList.Add(ExprType: TExpressionType);
|
||||
var NewSize: integer;
|
||||
begin
|
||||
|
||||
@ -231,6 +231,7 @@ type
|
||||
function GetSourceType: TCodeTreeNodeDesc;
|
||||
function NodeHasParentOfType(ANode: TCodeTreeNode;
|
||||
NodeDesc: TCodeTreeNodeDesc): boolean;
|
||||
function NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode): boolean;
|
||||
function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
|
||||
|
||||
constructor Create;
|
||||
@ -3252,6 +3253,20 @@ begin
|
||||
Result:=(ANode<>nil);
|
||||
end;
|
||||
|
||||
function TPascalParserTool.NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode
|
||||
): boolean;
|
||||
begin
|
||||
ANode:=ANode.Parent;
|
||||
while ANode<>nil do begin
|
||||
if ANode.Desc in (AllIdentifierDefinitions+AllPascalTypes) then begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
ANode:=ANode.Parent;
|
||||
end;
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
function TPascalParserTool.CleanPosIsInComment(CleanPos,
|
||||
CleanCodePosInFront: integer; var CommentStart, CommentEnd: integer): boolean;
|
||||
var CommentLvl, CurCommentPos: integer;
|
||||
|
||||
@ -36,7 +36,7 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, LCLLinux, Forms, Controls, Buttons, StdCtrls, ComCtrls,
|
||||
ExtCtrls, Menus, LResources, Graphics, Dialogs, ImgList, SynEdit, XMLCfg,
|
||||
DefineTemplates, CodeToolManager, CodeToolsOptions;
|
||||
DefineTemplates, CodeToolManager, CodeToolsOptions, CodeToolsDefPreview;
|
||||
|
||||
type
|
||||
TCodeToolsDefinesEditor = class(TForm)
|
||||
@ -125,12 +125,16 @@ type
|
||||
MoveFilePathDownBitBtn: TBitBtn;
|
||||
DeleteFilePathBitBtn: TBitBtn;
|
||||
InsertFilePathBitBtn: TBitBtn;
|
||||
|
||||
// preview
|
||||
DefinePreview: TCodeToolsDefinesPreview;
|
||||
|
||||
// misc
|
||||
procedure FormResize(Sender: TObject);
|
||||
procedure DefineTreeViewMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X,Y: integer);
|
||||
procedure ProjectSpecificCheckBoxClick(Sender: TObject);
|
||||
procedure RefreshPreview;
|
||||
|
||||
// exit menu
|
||||
procedure SaveAndExitMenuItemClick(Sender: TObject);
|
||||
@ -151,6 +155,9 @@ type
|
||||
procedure MoveNodeLvlDownMenuItemClick(Sender: TObject);
|
||||
procedure DeleteNodeMenuItemClick(Sender: TObject);
|
||||
procedure ConvertActionMenuItemClick(Sender: TObject);
|
||||
|
||||
// tools menu
|
||||
procedure OpenPreviewMenuItemClick(Sender: TObject);
|
||||
private
|
||||
FDefineTree: TDefineTree;
|
||||
FLastSelectedNode: TTreeNode;
|
||||
@ -161,7 +168,7 @@ type
|
||||
WithChilds,WithNextSiblings: boolean);
|
||||
procedure SetNodeImages(ANode: TTreeNode; WithSubNodes: boolean);
|
||||
procedure ValueAsPathToValueAsText;
|
||||
procedure SaveSelectedValues(ATreeNode: TTreeNode);
|
||||
procedure SaveValues(ATreeNode: TTreeNode);
|
||||
procedure ShowSelectedValues;
|
||||
procedure SetTypeLabel;
|
||||
function ValueToFilePathText(const AValue: string): string;
|
||||
@ -179,13 +186,134 @@ type
|
||||
|
||||
function ShowCodeToolsDefinesEditor(ACodeToolBoss: TCodeToolManager;
|
||||
Options: TCodeToolsOptions): TModalResult;
|
||||
function SaveGlobalCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
|
||||
Options: TCodeToolsOptions): TModalResult;
|
||||
function SaveProjectSpecificCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
|
||||
const ProjectInfoFile: string): TModalResult;
|
||||
function LoadCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
|
||||
Options: TCodeToolsOptions; const ProjectInfoFile: string): TModalResult;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
type
|
||||
TWinControlClass = class of TWinControl;
|
||||
|
||||
function SaveGlobalCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
|
||||
Options: TCodeToolsOptions): TModalResult;
|
||||
var
|
||||
XMLConfig: TXMLConfig;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
try
|
||||
XMLConfig:=TXMLConfig.Create(Options.Filename);
|
||||
try
|
||||
ACodeToolBoss.DefineTree.SaveToXMLConfig(XMLConfig,
|
||||
'CodeToolsGlobalDefines/',dtspGlobals);
|
||||
XMLConfig.Flush;
|
||||
finally
|
||||
XMLConfig.Free;
|
||||
end;
|
||||
Result:=mrOk;
|
||||
except
|
||||
on e: Exception do
|
||||
Result:=MessageDlg('Write error','Error while writing "'
|
||||
+Options.Filename+'"'#13+e.Message,mtError,[mbIgnore, mbAbort],0);
|
||||
end;
|
||||
end;
|
||||
|
||||
function SaveProjectSpecificCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
|
||||
const ProjectInfoFile: string): TModalResult;
|
||||
var
|
||||
XMLConfig: TXMLConfig;
|
||||
|
||||
{ procedure WriteTime;
|
||||
var hour, minutes, secs, msecs, usecs: word;
|
||||
begin
|
||||
GetTime(hour, minutes, secs, msecs, usecs);
|
||||
writeln('hour=',hour,' minutes=',minutes,' secs=',secs,' msecs=',msecs);
|
||||
end;}
|
||||
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
try
|
||||
XMLConfig:=TXMLConfig.Create(ProjectInfoFile);
|
||||
try
|
||||
ACodeToolBoss.DefineTree.SaveToXMLConfig(XMLConfig,
|
||||
'ProjectSpecificCodeToolsDefines/',dtspProjectSpecific);
|
||||
XMLConfig.Flush;
|
||||
finally
|
||||
XMLConfig.Free;
|
||||
end;
|
||||
Result:=mrOk;
|
||||
except
|
||||
on e: Exception do
|
||||
Result:=MessageDlg('Write error','Error while writing "'
|
||||
+ProjectInfoFile+'"'#13+e.Message,mtError,[mbIgnore, mbAbort],0);
|
||||
end;
|
||||
end;
|
||||
|
||||
function LoadCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
|
||||
Options: TCodeToolsOptions; const ProjectInfoFile: string): TModalResult;
|
||||
// replaces globals and project defines if changed
|
||||
var
|
||||
NewDefineTree: TDefineTree;
|
||||
XMLConfig: TXMLConfig;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
NewDefineTree:=TDefineTree.Create;
|
||||
try
|
||||
// create a temporary copy of current defines
|
||||
NewDefineTree.Assign(ACodeToolBoss.DefineTree);
|
||||
// remove non auto generated = all globals and project specific defines
|
||||
NewDefineTree.RemoveNonAutoCreated;
|
||||
if (Options<>nil) and (Options.Filename<>'') then begin
|
||||
// load global defines
|
||||
try
|
||||
XMLConfig:=TXMLConfig.Create(Options.Filename);
|
||||
try
|
||||
NewDefineTree.LoadFromXMLConfig(XMLConfig,
|
||||
'CodeToolsGlobalDefines/',dtlpGlobals,'Global');
|
||||
finally
|
||||
XMLConfig.Free;
|
||||
end;
|
||||
Result:=mrOk;
|
||||
except
|
||||
on e: Exception do
|
||||
Result:=MessageDlg('Read error','Error reading "'
|
||||
+Options.Filename+'"'#13+e.Message,mtError,[mbIgnore, mbAbort],0);
|
||||
end;
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
if ProjectInfoFile<>'' then begin
|
||||
// load project specific defines
|
||||
try
|
||||
XMLConfig:=TXMLConfig.Create(ProjectInfoFile);
|
||||
try
|
||||
NewDefineTree.LoadFromXMLConfig(XMLConfig,
|
||||
'ProjectSpecificCodeToolsDefines/',dtlpProjectSpecific,
|
||||
'ProjectSpecific');
|
||||
finally
|
||||
XMLConfig.Free;
|
||||
end;
|
||||
Result:=mrOk;
|
||||
except
|
||||
on e: Exception do
|
||||
Result:=MessageDlg('Read error','Error reading "'
|
||||
+ProjectInfoFile+'"'#13+e.Message,mtError,[mbIgnore, mbAbort],0);
|
||||
end;
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
// check if something changed (so the caches are only cleared if neccesary)
|
||||
if not NewDefineTree.IsEqual(ACodeToolBoss.DefineTree) then begin
|
||||
ACodeToolBoss.DefineTree.Assign(NewDefineTree);
|
||||
end;
|
||||
Result:=mrOk;
|
||||
finally
|
||||
NewDefineTree.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ShowCodeToolsDefinesEditor(ACodeToolBoss: TCodeToolManager;
|
||||
Options: TCodeToolsOptions): TModalResult;
|
||||
@ -194,43 +322,22 @@ begin
|
||||
CodeToolsDefinesEditor:=TCodeToolsDefinesEditor.Create(Application);
|
||||
CodeToolsDefinesEditor.Assign(ACodeToolBoss,Options);
|
||||
Result:=CodeToolsDefinesEditor.ShowModal;
|
||||
if Result=mrOk then begin
|
||||
if not CodeToolsDefinesEditor.DefineTree.IsEqual(ACodeToolBoss.DefineTree)
|
||||
then begin
|
||||
ACodeToolBoss.DefineTree.Assign(CodeToolsDefinesEditor.DefineTree);
|
||||
Result:=SaveGlobalCodeToolsDefines(ACodeToolBoss,Options);
|
||||
end;
|
||||
end;
|
||||
CodeToolsDefinesEditor.Free;
|
||||
end;
|
||||
|
||||
{ TCodeToolsDefinesEditor }
|
||||
|
||||
procedure TCodeToolsDefinesEditor.SaveAndExitMenuItemClick(Sender: TObject);
|
||||
var XMLConfig: TXMLConfig;
|
||||
t: TDefineTree;
|
||||
begin
|
||||
SaveSelectedValues(DefineTreeView.Selected);
|
||||
FLastSelectedNode:=nil;
|
||||
|
||||
t:=TDefineTree.Create;
|
||||
t.Assign(DefineTree);
|
||||
|
||||
writeln(' WWW TCodeToolsDefinesEditor.SaveAndExitMenuItemClick 0 ',t.IsEqual(DefineTree),' Consistency=',ConsistencyCheck);
|
||||
XMLConfig:=TXMLConfig.Create('/home/mattias/pascal/defines.xml');
|
||||
writeln(' WWW TCodeToolsDefinesEditor.SaveAndExitMenuItemClick A');
|
||||
DefineTree.SaveToXMLConfig(XMLConfig,'Globals/',dtspGlobals);
|
||||
writeln(' WWW TCodeToolsDefinesEditor.SaveAndExitMenuItemClick B');
|
||||
DefineTree.SaveToXMLConfig(XMLConfig,'Project/',dtspProjectSpecific);
|
||||
XMLConfig.Flush;
|
||||
|
||||
writeln(' WWW TCodeToolsDefinesEditor.SaveAndExitMenuItemClick C ');
|
||||
DefineTree.LoadFromXMLConfig(XMLConfig,'Globals/',dtlpGlobals,'Global');
|
||||
|
||||
writeln(' WWW TCodeToolsDefinesEditor.SaveAndExitMenuItemClick C ');
|
||||
DefineTree.LoadFromXMLConfig(XMLConfig,'Project/',dtlpProjectSpecific,'Project');
|
||||
|
||||
writeln(' WWW TCodeToolsDefinesEditor.SaveAndExitMenuItemClick D ',t.IsEqual(DefineTree),' Consistency=',ConsistencyCheck);
|
||||
RebuildDefineTreeView;
|
||||
|
||||
writeln(' WWW TCodeToolsDefinesEditor.SaveAndExitMenuItemClick END',' Consistency=',ConsistencyCheck);
|
||||
t.Free;
|
||||
XMLConfig.Free;
|
||||
|
||||
//ModalResult:=mrOk;
|
||||
SaveValues(DefineTreeView.Selected);
|
||||
ModalResult:=mrOk;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.DontSaveAndExitMenuItemClick(Sender: TObject);
|
||||
@ -433,6 +540,7 @@ var
|
||||
SelDefNode, PrevDefNode: TDefineTemplate;
|
||||
begin
|
||||
SelTreeNode:=DefineTreeView.Selected;
|
||||
SaveValues(SelTreeNode);
|
||||
if (SelTreeNode=nil) or (SelTreeNode.GetPrevSibling=nil) then exit;
|
||||
SelDefNode:=TDefineTemplate(SelTreeNode.Data);
|
||||
PrevDefNode:=SelDefNode.Prior;
|
||||
@ -450,6 +558,7 @@ var
|
||||
SelDefNode, NextDefNode: TDefineTemplate;
|
||||
begin
|
||||
SelTreeNode:=DefineTreeView.Selected;
|
||||
SaveValues(SelTreeNode);
|
||||
if (SelTreeNode=nil) or (SelTreeNode.GetNextSibling=nil) then exit;
|
||||
SelDefNode:=TDefineTemplate(SelTreeNode.Data);
|
||||
NextDefNode:=SelDefNode.Next;
|
||||
@ -470,6 +579,7 @@ var
|
||||
SelDefNode, PrevDefNode: TDefineTemplate;
|
||||
begin
|
||||
SelTreeNode:=DefineTreeView.Selected;
|
||||
SaveValues(SelTreeNode);
|
||||
if (SelTreeNode=nil) or (SelTreeNode.Parent=nil) then exit;
|
||||
SelDefNode:=TDefineTemplate(SelTreeNode.Data);
|
||||
if SelDefNode.IsAutoGenerated then begin
|
||||
@ -496,6 +606,7 @@ var
|
||||
SelDefNode, PrevDefNode: TDefineTemplate;
|
||||
begin
|
||||
SelTreeNode:=DefineTreeView.Selected;
|
||||
SaveValues(SelTreeNode);
|
||||
if (SelTreeNode=nil) or (SelTreeNode.GetPrevSibling=nil) then exit;
|
||||
SelDefNode:=TDefineTemplate(SelTreeNode.Data);
|
||||
PrevDefNode:=SelDefNode.Prior;
|
||||
@ -525,6 +636,7 @@ var
|
||||
SelDefNode: TDefineTemplate;
|
||||
begin
|
||||
SelTreeNode:=DefineTreeView.Selected;
|
||||
SaveValues(SelTreeNode);
|
||||
if (SelTreeNode=nil) then exit;
|
||||
SelDefNode:=TDefineTemplate(SelTreeNode.Data);
|
||||
if (SelDefNode.IsAutoGenerated) then begin
|
||||
@ -533,13 +645,11 @@ begin
|
||||
exit;
|
||||
end;
|
||||
if FLastSelectedNode=SelTreeNode then FLastSelectedNode:=nil;
|
||||
writeln(' AAA1 ',ConsistencyCheck);
|
||||
// delete node in TreeView
|
||||
SelTreeNode.Free;
|
||||
// delete node in DefineTree
|
||||
SelDefNode.Unbind;
|
||||
SelDefNode.Free;
|
||||
writeln(' AAA2 ',ConsistencyCheck);
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.ConvertActionMenuItemClick(Sender: TObject);
|
||||
@ -549,6 +659,7 @@ var
|
||||
SelDefNode: TDefineTemplate;
|
||||
begin
|
||||
SelTreeNode:=DefineTreeView.Selected;
|
||||
SaveValues(SelTreeNode);
|
||||
if SelTreeNode=nil then exit;
|
||||
SelDefNode:=TDefineTemplate(SelTreeNode.Data);
|
||||
if (SelDefNode.IsAutoGenerated) then begin
|
||||
@ -573,6 +684,17 @@ begin
|
||||
SetTypeLabel;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.OpenPreviewMenuItemClick(Sender: TObject);
|
||||
begin
|
||||
if DefinePreview=nil then begin
|
||||
DefinePreview:=TCodeToolsDefinesPreview.Create(Self);
|
||||
DefinePreview.DefineTree:=DefineTree;
|
||||
DefinePreview.Show;
|
||||
end;
|
||||
RefreshPreview;
|
||||
BringWindowToTop(DefinePreview.Handle);
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.ProjectSpecificCheckBoxClick(Sender: TObject);
|
||||
var
|
||||
SelTreeNode: TTreeNode;
|
||||
@ -596,6 +718,12 @@ begin
|
||||
SetTypeLabel;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.RefreshPreview;
|
||||
begin
|
||||
if DefinePreview=nil then exit;
|
||||
DefinePreview.ShowDefines;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.CreateComponents;
|
||||
|
||||
procedure CreateWinControl(var AWinControl: TWinControl;
|
||||
@ -821,9 +949,11 @@ begin
|
||||
ConvertActionMenuItem[i].OnClick:=@ConvertActionMenuItemClick;
|
||||
|
||||
// tools
|
||||
{ AddMenuItem(ToolsMenuItem,'ToolsMenuItem','Tools',nil);
|
||||
{AddMenuItem(ToolsMenuItem,'ToolsMenuItem','Tools',nil);
|
||||
AddMenuItem(OpenPreviewMenuItem,'OpenPreviewMenuItem','Open Preview',
|
||||
ToolsMenuItem);
|
||||
OpenPreviewMenuItem.OnClick:=@OpenPreviewMenuItemClick;
|
||||
|
||||
AddMenuItem(ShowMacroListMenuItem,'ShowMacroListMenuItem','Show Macros',
|
||||
ToolsMenuItem);}
|
||||
|
||||
@ -1017,7 +1147,7 @@ begin
|
||||
ValueAsTextSynEdit.Text:=s;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.SaveSelectedValues(ATreeNode: TTreeNode);
|
||||
procedure TCodeToolsDefinesEditor.SaveValues(ATreeNode: TTreeNode);
|
||||
var
|
||||
ADefNode: TDefineTemplate;
|
||||
s: string;
|
||||
@ -1043,6 +1173,7 @@ begin
|
||||
end;
|
||||
ADefNode.Value:=s;
|
||||
end;
|
||||
FLastSelectedNode:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1053,7 +1184,7 @@ var
|
||||
begin
|
||||
SelTreeNode:=DefineTreeView.Selected;
|
||||
if SelTreeNode<>FLastSelectedNode then begin
|
||||
SaveSelectedValues(FLastSelectedNode);
|
||||
SaveValues(FLastSelectedNode);
|
||||
end;
|
||||
if SelTreeNode<>nil then begin
|
||||
SelDefNode:=TDefineTemplate(SelTreeNode.Data);
|
||||
@ -1122,6 +1253,7 @@ var SelTreeNode, NodeInFront, ParentNode,
|
||||
NewName, NewDescription, NewVariable, NewValue: string;
|
||||
begin
|
||||
SelTreeNode:=DefineTreeView.Selected;
|
||||
SaveValues(SelTreeNode);
|
||||
NodeInFront:=nil;
|
||||
ParentNode:=nil;
|
||||
if SelTreeNode<>nil then begin
|
||||
|
||||
150
ide/codetoolsdefpreview.pas
Normal file
150
ide/codetoolsdefpreview.pas
Normal file
@ -0,0 +1,150 @@
|
||||
{ /***************************************************************************
|
||||
codetoolsoptions.pas - Lazarus IDE unit
|
||||
-----------------------------------------
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
/***************************************************************************
|
||||
* *
|
||||
* This program 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. *
|
||||
* *
|
||||
***************************************************************************/
|
||||
|
||||
Author: Mattias Gaertner
|
||||
|
||||
Abstract:
|
||||
- TCodeToolsDefinesPreview is a preview for the defines of a single
|
||||
directory, used by TCodeToolsDefinesEditor.
|
||||
|
||||
}
|
||||
unit CodeToolsDefPreview;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLLinux, Forms, Controls, Buttons, StdCtrls, ComCtrls,
|
||||
ExtCtrls, Menus, LResources, Graphics, Dialogs, ImgList, SynEdit, ExprEval,
|
||||
DefineTemplates;
|
||||
|
||||
type
|
||||
TCodeToolsDefinesPreview = class(TForm)
|
||||
DirectoryLabel: TLabel;
|
||||
DirectoryEdit: TEdit;
|
||||
DefListBox: TListBox;
|
||||
|
||||
// misc
|
||||
procedure FormResize(Sender: TObject);
|
||||
private
|
||||
FDefineTree: TDefineTree;
|
||||
procedure CreateComponents;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure ShowDefines;
|
||||
property DefineTree: TDefineTree read FDefineTree write FDefineTree;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{ TCodeToolsDefinesPreview }
|
||||
|
||||
procedure TCodeToolsDefinesPreview.FormResize(Sender: TObject);
|
||||
var MaxX, MaxY: integer;
|
||||
begin
|
||||
MaxX:=ClientWidth-2;
|
||||
MaxY:=ClientHeight-2;
|
||||
|
||||
DirectoryLabel.SetBounds(5,3,150,DirectoryLabel.Height);
|
||||
|
||||
with DirectoryEdit do begin
|
||||
Left:=0;
|
||||
Top:=DirectoryLabel.Top+DirectoryLabel.Height+2;
|
||||
Width:=MaxX;
|
||||
end;
|
||||
|
||||
with DefListBox do begin
|
||||
Left:=0;
|
||||
Top:=DirectoryEdit.Top+DirectoryEdit.Height+3;
|
||||
Width:=MaxX;
|
||||
Height:=MaxY-Top;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesPreview.CreateComponents;
|
||||
begin
|
||||
DirectoryLabel:=TLabel.Create(Self);
|
||||
with DirectoryLabel do begin
|
||||
Name:='DirectoryLabel';
|
||||
Parent:=Self;
|
||||
Visible:=true;
|
||||
end;
|
||||
|
||||
DirectoryEdit:=TEdit.Create(Self);
|
||||
with DirectoryEdit do begin
|
||||
Name:='DirectoryEdit';
|
||||
Parent:=Self;
|
||||
Visible:=true;
|
||||
end;
|
||||
|
||||
DefListBox:=TListBox.Create(Self);
|
||||
with DefListBox do begin
|
||||
Name:='DefListBox';
|
||||
Parent:=Self;
|
||||
Visible:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCodeToolsDefinesPreview.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
if LazarusResources.Find(ClassName)=nil then begin
|
||||
SetBounds((Screen.Width-400) div 2,(Screen.Height-400) div 2, 420, 420);
|
||||
Caption:='CodeTools Defines Preview';
|
||||
OnResize:=@FormResize;
|
||||
|
||||
CreateComponents;
|
||||
end;
|
||||
Resize;
|
||||
end;
|
||||
|
||||
destructor TCodeToolsDefinesPreview.Destroy;
|
||||
begin
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesPreview.ShowDefines;
|
||||
var
|
||||
ExprEval: TExpressionEvaluator;
|
||||
i: integer;
|
||||
begin
|
||||
DefListBox.Items.BeginUpdate;
|
||||
if DefineTree<>nil then begin
|
||||
DefineTree.ClearCache;
|
||||
ExprEval:=DefineTree.GetDefinesForDirectory(DirectoryLabel.Text);
|
||||
if ExprEval<>nil then begin
|
||||
for i:=0 to ExprEval.Count-1 do begin
|
||||
if i<DefListBox.Items.Count then
|
||||
// replace old value
|
||||
DefListBox.Items[i]:=ExprEval.Items(i)
|
||||
else
|
||||
// add value
|
||||
DefListBox.Items.Add(ExprEval.Items(i));
|
||||
end;
|
||||
while DefListBox.Items.Count>ExprEval.Count do
|
||||
// delete old value
|
||||
DefListBox.Items.Delete(DefListBox.Items.Count-1);
|
||||
end else
|
||||
DefListBox.Items.Clear;
|
||||
end;
|
||||
DefListBox.Items.EndUpdate;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -55,7 +55,7 @@ type
|
||||
FPropertyStoredIdentPostfix: string;
|
||||
FPrivatVariablePrefix: string;
|
||||
FSetPropertyVariablename: string;
|
||||
|
||||
|
||||
procedure SetFilename(const AValue: string);
|
||||
public
|
||||
constructor Create;
|
||||
|
||||
10
ide/main.pp
10
ide/main.pp
@ -3430,6 +3430,7 @@ writeln('TMainIDE.DoNewProject A');
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:=LoadCodeToolsDefines(CodeToolBoss,CodeToolsOpts,'');
|
||||
CreateProjectDefineTemplate(Project.CompilerOptions,Project.SrcPath);
|
||||
|
||||
// set all modified to false
|
||||
@ -3613,6 +3614,9 @@ writeln('AnUnitInfo.Filename=',AnUnitInfo.Filename);
|
||||
if not SaveToTestDir then begin
|
||||
Result:=Project.WriteProject;
|
||||
if Result=mrAbort then exit;
|
||||
Result:=SaveProjectSpecificCodeToolsDefines(CodeToolBoss,
|
||||
Project.ProjectInfoFile);
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
// save main source
|
||||
if MainUnitInfo<>nil then begin
|
||||
@ -3740,6 +3744,9 @@ CheckHeap(IntToStr(GetMem_Cnt));
|
||||
LPIFilename:=ChangeFileExt(AFilename,'.lpi');
|
||||
Project:=TProject.Create(ptProgram);
|
||||
Project.ReadProject(LPIFilename);
|
||||
Result:=LoadCodeToolsDefines(CodeToolBoss,CodeToolsOpts,
|
||||
Project.ProjectInfoFile);
|
||||
if Result<>mrOk then exit;
|
||||
if Project.MainUnit>=0 then begin
|
||||
// read MainUnit Source
|
||||
Result:=DoLoadCodeBuffer(NewBuf,Project.Units[Project.MainUnit].Filename,
|
||||
@ -6216,6 +6223,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.241 2002/03/07 14:14:23 lazarus
|
||||
MG: fixed find declaration new nodecache flags, find next
|
||||
|
||||
Revision 1.240 2002/03/05 14:52:15 lazarus
|
||||
MG: updates for codetools defines
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user