paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 15:39:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: code observer: parsing inner blocks and brackets

Browse Source 
git-svn-id: trunk@19565 -
This commit is contained in:
mattias 2009-04-22 06:17:23 +00:00
parent 63f92835aa
commit a9d598fdb3
1 changed files with 294 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

189
ide/codeexplorer.pas
View File

@ -74,6 +74,41 @@ type
cepDirectives
);
TCodeObsStackItemType = (
cositNone,
cositBegin,
cositRepeat,
cositTry,
cositFinally,
cositExcept,
cositCase,
cositCaseElse,
cositRoundBracketOpen,
cositEdgedBracketOpen
);
TCodeObsStackItem = record
StartPos: integer;
Typ: TCodeObsStackItemType;
end;
TCodeObsStack = ^TCodeObsStackItem;
{ TCodeObserverStatementState }
TCodeObserverStatementState = class
public
Stack: TCodeObsStack;
StackPtr: integer;
StackCapacity: integer;
IgnoreConstLevel: integer;
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Push(Typ: TCodeObsStackItemType; StartPos: integer);
function Pop: TCodeObsStackItemType;
procedure PopAll;
function TopType: TCodeObsStackItemType;
end;
{ TCodeExplorerView }
TCodeExplorerView = class(TForm)
@ -171,8 +206,9 @@ type
CreateSiblings: boolean);
procedure CreateObservations(Tool: TCodeTool);
function CreateObserverNode(Tool: TCodeTool; f: TCEObserverCategory): TTreeNode;
procedure FindObserverConstants(Tool: TCodeTool; CodeNode: TCodeTreeNode;
StartPos, EndPos: integer);
procedure CreateObserverNodesForStatement(Tool: TCodeTool;
CodeNode: TCodeTreeNode; StartPos, EndPos: integer;
ObserverState: TCodeObserverStatementState);
procedure FindObserverTodos(Tool: TCodeTool);
procedure SetCodeFilter(const AValue: string);
procedure SetCurrentPage(const AValue: TCodeExplorerPage);
@ -857,9 +893,12 @@ var
f: TCEObserverCategory;
ObserverCats: TCEObserverCategories;
ProcNode: TCodeTreeNode;
ObsState: TCodeObserverStatementState;
begin
CodeNode:=Tool.Tree.Root;
ObserverCats:=CodeExplorerOptions.ObserverCategories;
ObsState:=TCodeObserverStatementState.Create;
try
while CodeNode<>nil do begin
case CodeNode.Desc of
ctnBeginBlock:
@ -888,7 +927,8 @@ begin
end;
if (cefcUnnamedConsts in ObserverCats)
and (not CodeNode.HasParentOfType(ctnBeginBlock)) then begin
FindObserverConstants(Tool,CodeNode,CodeNode.StartPos,CodeNode.EndPos);
CreateObserverNodesForStatement(Tool,CodeNode,
CodeNode.StartPos,CodeNode.EndPos,ObsState);
end;
if (cefcEmptyBlocks in ObserverCats)
and CodeIsOnlySpace(Tool.Src,CodeNode.StartPos+length('begin'),
@ -986,6 +1026,9 @@ begin
if cefcToDos in ObserverCats then
FindObserverTodos(Tool);
finally
ObsState.Free;
end;
// add numbers
for f:=low(TCEObserverCategory) to high(TCEObserverCategory) do
@ -1030,9 +1073,9 @@ begin
Result:=fObserverCatNodes[f];
end;
procedure TCodeExplorerView.FindObserverConstants(Tool: TCodeTool;
procedure TCodeExplorerView.CreateObserverNodesForStatement(Tool: TCodeTool;
CodeNode: TCodeTreeNode;
StartPos, EndPos: integer);
StartPos, EndPos: integer; ObserverState: TCodeObserverStatementState);
var
Data: TViewNodeData;
ObsTVNode: TTreeNode;
@ -1044,18 +1087,26 @@ var
CurAtom, Last1Atom, Last2Atom: TCommonAtomFlag;
FuncName: string;
Atom: TAtomPosition;
c1: Char;
Typ: TCodeObsStackItemType;
begin
if (StartPos<1) or (StartPos>=EndPos) then exit;
Tool.MoveCursorToCleanPos(StartPos);
Last1Atom:=cafNone;
Last2Atom:=cafNone;
ObserverState.PopAll;
while Tool.CurPos.StartPos<EndPos do begin
CurAtom:=cafNone;
case Tool.Src[Tool.CurPos.StartPos] of
c1:=Tool.Src[Tool.CurPos.StartPos];
case c1 of
'''','#','0'..'9','$','%':
begin
// a constant
if Tool.AtomIsEmptyStringConstant then begin
if (ObserverState.IgnoreConstLevel>=0)
and (ObserverState.IgnoreConstLevel>=ObserverState.StackPtr)
// ignore range
then begin
end else if Tool.AtomIsEmptyStringConstant then begin
// ignore empty string constant ''
end else if Tool.AtomIsCharConstant
and (not CodeExplorerOptions.ObserveCharConst) then
@ -1101,11 +1152,14 @@ begin
'.':
CurAtom:=cafPoint;
'_','a'..'z','A'..'Z':
CurAtom:=cafWord;
'(','[':
if Last1Atom=cafWord then
begin
if c1='(' then
ObserverState.Push(cositRoundBracketOpen,Tool.CurPos.StartPos)
else
ObserverState.Push(cositEdgedBracketOpen,Tool.CurPos.StartPos);
if (Last1Atom=cafWord)
and (ObserverState.IgnoreConstLevel<0) then
begin
Atom:=Tool.LastAtoms.GetValueAt(0);
FuncName:=copy(Tool.Src,Atom.StartPos,Atom.EndPos-Atom.StartPos);
@ -1114,10 +1168,65 @@ begin
if CodeExplorerOptions.COIgnoreConstInFunc(FuncName) then
begin
// skip this function call
Tool.ReadTilBracketClose(false);
ObserverState.IgnoreConstLevel:=ObserverState.StackPtr;
end;
end;
end;
')',']':
begin
while ObserverState.StackPtr>0 do
begin
Typ:=ObserverState.TopType;
if Typ in [cositRoundBracketOpen,cositEdgedBracketOpen]
then begin
ObserverState.Pop;
// normally brackets must match () []
// but during editing often the brackets don't match
// for example [( ]
// skip silently
if (Typ=cositRoundBracketOpen)=(c1='(') then break;
end else begin
// missing bracket close
break;
end;
end;
end;
'_','a'..'z','A'..'Z':
begin
CurAtom:=cafWord;
if Tool.UpAtomIs('END') then
begin
while ObserverState.StackPtr>0 do
begin
Typ:=ObserverState.Pop;
if Typ in [cositBegin,cositFinally,cositExcept,cositCase,cositCaseElse]
then
break;
end;
end
else if Tool.UpAtomIs('BEGIN') then
ObserverState.Push(cositBegin,Tool.CurPos.StartPos)
else if Tool.UpAtomIs('REPEAT') then
ObserverState.Push(cositRepeat,Tool.CurPos.StartPos)
else if Tool.UpAtomIs('TRY') then
ObserverState.Push(cositTry,Tool.CurPos.StartPos)
else if Tool.UpAtomIs('FINALLY') or Tool.UpAtomIs('EXCEPT') then
begin
while ObserverState.StackPtr>0 do
begin
Typ:=ObserverState.Pop;
if Typ=cositTry then
break;
end;
end
else if Tool.UpAtomIs('CASE') then
ObserverState.Push(cositCase,Tool.CurPos.StartPos)
else if Tool.UpAtomIs('ELSE') and (ObserverState.TopType=cositCase) then
ObserverState.Pop;
end;
end;
// read next atom
Last2Atom:=Last1Atom;
Last1Atom:=CurAtom;
@ -1782,6 +1891,62 @@ begin
Result:=0;
end;
{ TCodeObserverStatementState }
constructor TCodeObserverStatementState.Create;
begin
end;
destructor TCodeObserverStatementState.Destroy;
begin
Clear;
inherited Destroy;
end;
procedure TCodeObserverStatementState.Clear;
begin
ReAllocMem(Stack,0);
StackCapacity:=0;
StackPtr:=0;
end;
procedure TCodeObserverStatementState.Push(Typ: TCodeObsStackItemType;
StartPos: integer);
begin
if StackPtr=StackCapacity then
begin
StackCapacity:=StackCapacity*2+10;
ReAllocMem(Stack,SizeOf(TCodeObsStackItem)*StackCapacity);
end;
Stack[StackPtr].Typ:=Typ;
Stack[StackPtr].StartPos:=StartPos;
inc(StackPtr);
end;
function TCodeObserverStatementState.Pop: TCodeObsStackItemType;
begin
if StackPtr=0 then
RaiseGDBException('inconsistency');
dec(StackPtr);
Result:=Stack[StackPtr].Typ;
if IgnoreConstLevel>StackPtr then
IgnoreConstLevel:=-1;
end;
procedure TCodeObserverStatementState.PopAll;
begin
StackPtr:=0;
end;
function TCodeObserverStatementState.TopType: TCodeObsStackItemType;
begin
if StackPtr>0 then
Result:=Stack[StackPtr-1].Typ
else
Result:=cositNone;
end;
initialization
{$I codeexplorer.lrs}
CodeExplorerView:=nil;