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

IDE: code explorer: added figures for Paul

Browse Source 
git-svn-id: trunk@19458 -
This commit is contained in:
mattias 2009-04-16 22:55:18 +00:00
parent 3c6e7b1b20
commit 7400ba8680
12 changed files with 1081 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

285
components/codetools/basiccodetools.pas
View File

@ -90,8 +90,10 @@ function IsValidIdentPair(const NamePair: string;
out First, Second: string): boolean;
// line/code ends
function LineEndCount(const Txt: string): integer;
function LineEndCount(const Txt: string; out LengthOfLastLine:integer): integer;
function LineEndCount(const Txt: string): integer; inline;
function LineEndCount(const Txt: string; out LengthOfLastLine:integer): integer; inline;
function LineEndCount(const Txt: string; StartPos, EndPos: integer;
out LengthOfLastLine:integer): integer;
function EmptyCodeLineCount(const Source: string; StartPos, EndPos: integer;
NestedComments: boolean): integer;
function PositionsInSameLine(const Source: string;
@ -148,6 +150,8 @@ function TextBeginsWith(Txt: PChar; TxtLen: integer; StartTxt: PChar;
StartTxtLen: integer; CaseSensitive: boolean): boolean;
function StrBeginsWith(const s, Prefix: string): boolean;
function IdentifierPos(Search, Identifier: PChar): PtrInt;
function CompareAtom(p1, p2: PChar): integer;
function CompareStringConstants(p1, p2: PChar): integer; // compare case sensitive
// space and special chars
function TrimCodeSpace(const ACode: string): string;
@ -297,6 +301,8 @@ procedure ReadRawNextPascalAtom(const Source: string;
NestedComments: boolean = false);
function ReadTilPascalBracketClose(const Source: string;
var Position: integer; NestedComments: boolean = false): boolean;
function GetAtomLength(p: PChar): integer;
function GetAtomString(p: PChar): string;
//-----------------------------------------------------------------------------
@ -1329,6 +1335,26 @@ begin
inc(LineEnd);
end;
function LineEndCount(const Txt: string; StartPos, EndPos: integer; out
LengthOfLastLine: integer): integer;
var i, LastLineEndPos: integer;
begin
i:=StartPos;
LastLineEndPos:=0;
Result:=0;
while i<EndPos do begin
if (Txt[i] in [#10,#13]) then begin
inc(Result);
inc(i);
if (i<EndPos) and (Txt[i] in [#10,#13]) and (Txt[i-1]<>Txt[i]) then
inc(i);
LastLineEndPos:=i;
end else
inc(i);
end;
LengthOfLastLine:=EndPos-LastLineEndPos;
end;
function EmptyCodeLineCount(const Source: string; StartPos, EndPos: integer;
NestedComments: boolean): integer;
{ search forward for a line end or code
@ -1770,7 +1796,7 @@ begin
// compiler directive -> read til comment end
inc(Position,2);
while (Position<Len)
and ((Source[Position]<>'*') or (Source[Position]<>')')) do
and ((Source[Position]<>'*') or (Source[Position+1]<>')')) do
inc(Position);
inc(Position,2);
end else
@ -1842,24 +1868,142 @@ begin
end;
end;
function GetAtomLength(p: PChar): integer;
var
c1: Char;
CommentLvl: Integer;
NestedComments: Boolean;
c2: Char;
OldP: PChar;
begin
NestedComments:=false;
OldP:=p;
// read atom
c1:=p^;
case c1 of
'A'..'Z','a'..'z','_':
begin
// identifier
inc(p);
while (IsIdentChar[p^]) do
inc(p);
end;
'0'..'9': // number
begin
inc(p);
// read numbers
while (p^ in ['0'..'9']) do
inc(p);
if (p^='.')
and (p[1]<>'.') then begin
// real type number
inc(p);
while (p^ in ['0'..'9']) do
inc(p);
end;
if (p^ in ['e','E']) then begin
// read exponent
inc(p);
if (p^='-') then inc(p);
while (p^ in ['0'..'9']) do
inc(p);
end;
end;
'''','#': // string constant
begin
while true do begin
case p^ of
'#':
begin
inc(p);
while (p^ in ['0'..'9']) do
inc(p);
end;
'''':
begin
inc(p);
while (p^<>'''') do
inc(p);
inc(p);
end;
else
break;
end;
end;
end;
'$': // hex constant
begin
inc(p);
while (IsHexNumberChar[p^]) do
inc(p);
end;
'{': // compiler directive
begin
CommentLvl:=1;
while true do begin
inc(p);
case p^ of
#0: break;
'{': if NestedComments then
begin
inc(CommentLvl);
end;
'}':
begin
dec(CommentLvl);
if CommentLvl=0 then begin
inc(p);
break;
end;
end;
end;
end;
end;
'(': // bracket or compiler directive
if (p^='*') then begin
// compiler directive -> read til comment end
inc(p,2);
while ((p^<>'*') or (p[1]<>')')) do
inc(p);
inc(p,2);
end else
// round bracket open
inc(p);
else
inc(p);
c2:=p^;
// test for double char operators :=, +=, -=, /=, *=, <>, <=, >=, **
if ((c2='=') and (IsEqualOperatorStartChar[c1]))
or ((c1='<') and (c2='>'))
or ((c1='.') and (c2='.'))
or ((c1='*') and (c2='*'))
then
inc(p)
else if ((c1='@') and (c2='@')) then begin
// @@ label
repeat
inc(p);
until (not IsIdentChar[p^]);
end;
end;
Result:=P-OldP;
end;
function GetAtomString(p: PChar): string;
var
l: LongInt;
begin
if p=nil then exit('');
l:=GetAtomLength(p);
SetLength(Result,l);
if l>0 then
System.Move(p^,Result[1],length(Result));
end;
function LineEndCount(const Txt: string;
out LengthOfLastLine: integer): integer;
var i, LastLineEndPos: integer;
begin
i:=1;
LastLineEndPos:=0;
Result:=0;
while i<=length(Txt) do begin
if (Txt[i] in [#10,#13]) then begin
inc(Result);
inc(i);
if (i<=length(Txt)) and (Txt[i] in [#10,#13]) and (Txt[i-1]<>Txt[i]) then
inc(i);
LastLineEndPos:=i-1;
end else
inc(i);
end;
LengthOfLastLine:=length(Txt)-LastLineEndPos;
Result:=LineEndCount(Txt,1,length(Txt),LengthOfLastLine);
end;
function FindFirstNonSpaceCharInLine(const Source: string;
@ -3027,6 +3171,111 @@ begin
Result:=-1;
end;
function CompareAtom(p1, p2: PChar): integer;
var
Len1: LongInt;
Len2: LongInt;
l: LongInt;
c1: Char;
c2: Char;
begin
// quick test for the common case:
if (p1^<>p2^) then begin
c1:=UpChars[p1^];
c2:=UpChars[p2^];
if c1<c2 then
exit(1)
else if c1>c2 then
exit(-1);
end;
if p1^='''' then begin
// compare string constants case sensitive
Result:=CompareStringConstants(p1,p2);
exit;
end;
// full comparison
Len1:=GetAtomLength(p1);
Len2:=GetAtomLength(p2);
l:=Len1;
if l>Len2 then l:=Len2;
while l>0 do begin
if (p1^<>p2^) then begin
c1:=UpChars[p1^];
c2:=UpChars[p2^];
if c1<c2 then
exit(1)
else if c1>c2 then
exit(-1);
end;
inc(p1);
inc(p2);
dec(l);
end;
end;
function CompareStringConstants(p1, p2: PChar): integer;
// 1: 'aa' 'ab' because bigger
// 1: 'aa' 'a' because longer
begin
if (p1^='''') and (p2^='''') then begin
inc(p1);
inc(p2);
repeat
if p1^<p2^ then
exit(1) // p1 bigger
else if p1^>p2 then
exit(-1); // p2 bigger
inc(p1);
inc(p2);
if p1^='''' then begin
// maybe ''
inc(p1);
inc(p2);
if p1^='''' then begin
if p2^='''' then begin
inc(p1);
inc(p2);
end else begin
// p1 is longer (e.g.: 'a''b' 'a')
exit(1);
end;
end else if p2^='''' then begin
// p2 is longer (e.g. 'a' 'a''b')
exit(-1);
end else begin
// same
exit(0);
end;
end;
if p1^ in [#0,#10,#13] then begin
// end of p1 found
if p2^ in [#0,#10,#13] then begin
// same
exit(0);
end else begin
// p2 is longer
exit(-1);
end;
end else if p2^ in [#0,#10,#13] then begin
// p1 is longer
exit(1);
end;
until false;
end else begin
if p1^='''' then
// p1 longer
exit(1)
else if p2^='''' then
// p2 longer
exit(-1)
else
// both empty
exit(0);
end;
end;
function GetIdentifier(Identifier: PChar): string;
var len: integer;
begin

1
components/codetools/codetoolmanager.pas
View File

@ -1730,6 +1730,7 @@ begin
NewX:=NewPos.X;
NewY:=NewPos.Y;
NewCode:=NewPos.Code;
debugln(['TCodeToolManager.FindDeclaration ',DbgsCXY(NewPos)]);
end;
{$IFDEF DoNotHandleFindDeclException}
finally

39
components/codetools/codetree.pas
View File

@ -82,19 +82,19 @@ const
ctnClass = 30;
ctnClassInterface = 31;
ctnClassTypePrivate = 32;
ctnClassTypeProtected = 33;
ctnClassTypePublic = 34;
ctnClassTypePublished = 35;
ctnClassVarPrivate = 36;
ctnClassVarProtected = 37;
ctnClassVarPublic = 38;
ctnClassVarPublished = 39;
ctnClassPrivate = 40;
ctnClassProtected = 41;
ctnClassPublic = 42;
ctnClassPublished = 43;
ctnClassGUID = 44;
ctnClassGUID = 32;
ctnClassTypePrivate = 33;
ctnClassTypeProtected = 34;
ctnClassTypePublic = 35;
ctnClassTypePublished = 36;
ctnClassVarPrivate = 37;
ctnClassVarProtected = 38;
ctnClassVarPublic = 39;
ctnClassVarPublished = 40;
ctnClassPrivate = 41;
ctnClassProtected = 42;
ctnClassPublic = 43;
ctnClassPublished = 44;
ctnProperty = 50;
ctnMethodMap = 51;
@ -237,6 +237,7 @@ type
function GetLevel: integer;
function DescAsString: string;
function GetRoot: TCodeTreeNode;
function ChildCount: integer;
function FindOwner: TObject;
procedure Clear;
constructor Create;
@ -782,6 +783,18 @@ begin
while (Result.PriorBrother<>nil) do Result:=Result.PriorBrother;
end;
function TCodeTreeNode.ChildCount: integer;
var
Node: TCodeTreeNode;
begin
Result:=0;
Node:=FirstChild;
while Node<>nil do begin
inc(Result);
Node:=Node.NextBrother;
end;
end;
function TCodeTreeNode.FindOwner: TObject;
begin
Result:=FindOwnerOfCodeTreeNode(Self);

27
components/codetools/customcodetool.pas
View File

@ -259,6 +259,7 @@ type
function AtomIsRealNumber: boolean;
function AtomIsStringConstant: boolean; {$IFDEF UseInline}inline;{$ENDIF}
function AtomIsCharConstant: boolean;
function AtomIsEmptyStringConstant: boolean;
function AtomIsIdentifier(ExceptionOnNotFound: boolean): boolean;
function LastAtomIs(BackIndex: integer;
const AnAtom: shortstring): boolean; // 0=current, 1=prior current, ...
@ -730,14 +731,16 @@ end;
function TCustomCodeTool.AtomIsCharConstant: boolean;
var i: integer;
p: LongInt;
begin
Result:=false;
if (CurPos.StartPos<=SrcLen) then begin
case Src[CurPos.StartPos] of
p:=CurPos.StartPos;
if (p<=SrcLen) then begin
case Src[p] of
'#':
begin
i:=CurPos.StartPos+1;
i:=p+1;
if (i<=SrcLen) then begin
if IsNumberChar[Src[i]] then begin
// decimal
@ -756,11 +759,11 @@ begin
'''':
begin
if (CurPos.StartPos+2<=SrcLen) and (Src[CurPos.StartPos+1]<>'''')
and (Src[CurPos.StartPos+2]='''') then begin
if (p+2<=SrcLen) and (Src[p+1]<>'''')
and (Src[p+2]='''') then begin
// a single char
if (CurPos.StartPos+2<SrcLen)
and (not (Src[CurPos.StartPos+3] in ['''','#'])) then
if (p+2<SrcLen)
and (not (Src[p+3] in ['''','#'])) then
Result:=true;
end;
end;
@ -769,6 +772,16 @@ begin
end;
end;
function TCustomCodeTool.AtomIsEmptyStringConstant: boolean;
var
p: LongInt;
begin
p:=CurPos.StartPos;
while (p<=SrcLen) and (Src[p]='''') do inc(p);
dec(p,CurPos.StartPos);
Result:=(p>0) and ((p and 1)=0);
end;
function TCustomCodeTool.LastAtomIs(BackIndex: integer;
const AnAtom: shortstring): boolean;
var ap: TAtomPosition;

4
components/codetools/finddeclarationtool.pas
View File

@ -8550,6 +8550,10 @@ procedure TFindDeclarationParams.PrettifyResult;
begin
// adjust result for nicer position
if (NewNode<>nil) then begin
{$IFDEF CheckNodeTool}
if NewCodeTool<>nil then
NewCodeTool.CheckNodeTool(NewNode);
{$ENDIF}
if (NewNode.Desc=ctnProcedure)
and (NewNode.FirstChild<>nil)
and (NewNode.FirstChild.Desc=ctnProcedureHead) then begin

16
components/codetools/pascalreadertool.pas
View File

@ -61,6 +61,7 @@ type
function ExtractIdentCharsFromStringConstant(
StartPos, MinPos, MaxPos, MaxLen: integer): string;
function ReadStringConstantValue(StartPos: integer): string;
function GetNodeIdentifier(Node: TCodeTreeNode): PChar;
// properties
function ExtractPropType(PropNode: TCodeTreeNode;
@ -1145,6 +1146,21 @@ begin
end;
end;
function TPascalReaderTool.GetNodeIdentifier(Node: TCodeTreeNode): PChar;
begin
Result:=nil;
if Node=nil then exit;
case Node.Desc of
ctnProcedure,ctnProcedureHead:
Result:=GetProcNameIdentifier(Node);
ctnProperty:
Result:=GetPropertyNameIdentifier(Node);
ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,
ctnEnumIdentifier,ctnIdentifier:
Result:=@Src[Node.StartPos];
end;
end;
function TPascalReaderTool.FindVarNode(StartNode: TCodeTreeNode;
const UpperVarName: string): TCodeTreeNode;
begin

262
ide/codeexplopts.pas
View File

@ -35,8 +35,10 @@ interface
uses
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
Laz_XMLCfg, Buttons, ExtCtrls, FileUtil, IDEContextHelpEdit,
LazConf, IDEProcs, LazarusIDEStrConsts, StdCtrls, ButtonPanel;
Buttons, ExtCtrls, FileUtil, StdCtrls, ButtonPanel, AvgLvlTree,
CodeToolManager, Laz_XMLCfg, BasicCodeTools,
IDEContextHelpEdit,
LazConf, IDEProcs, LazarusIDEStrConsts;
type
{ TCodeExplorerOptions }
@ -59,22 +61,49 @@ type
cecVariables,
cecConstants,
cecProperties,
cecProcedures
cecProcedures,
cecFigures
);
TCodeExplorerCategories = set of TCodeExplorerCategory;
TCEFigureCategory = (
cefcLongProcs,
cefcLongParamLists,
cefcEmptyProcs,
cefcNestedProcs,
cefcUnnamedConsts,
cefcPublishedPropWithoutDefault,
cefcUnsortedClassVisibility,
cefcEmptyClassSections,
cefcUnsortedClassMembers,
cefcToDos
);
TCEFigureCategories = set of TCEFigureCategory;
const
FirstCodeExplorerCategory = cecUses;
DefaultCodeExplorerCategories = [cecUses,
cecTypes,cecVariables,cecConstants,cecProcedures];
cefcAll = [low(TCEFigureCategory)..high(TCEFigureCategory)];
DefaultCodeExplorerFigureCategories = cefcAll;
DefaultFigLongProcLineCount = 50;
DefaultFigLongParamListCount = 6;
DefaultFigNestedProcCount = 3;
DefaultFigureCharConst = false;
type
TCodeExplorerOptions = class(TPersistent)
private
FCategories: TCodeExplorerCategories;
FFigureCharConst: boolean;
FLongParamListCount: integer;
FLongProcLineCount: integer;
FNestedProcCount: integer;
FFigures: TCEFigureCategories;
FFollowCursor: boolean;
FMode : TCodeExplorerMode;
FNotFigureConstants: TAvgLvlTree;// tree of AnsiString
FOptionsFilename: string;
FRefresh: TCodeExplorerRefresh;
public
@ -86,12 +115,25 @@ type
procedure Save;
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
function CreateListOfNotFigureConstants: TStrings;
procedure ClearNotFigureConstants;
procedure SetListOfNotFigureConstants(List: TStrings);
function NotFigureConstant(p: PChar): boolean;// test if atom is in NotFigureConstants
procedure AddNotFigureConstant(const Atom: string);
function IsNotFigureConstantsDefault: boolean;
public
property Refresh: TCodeExplorerRefresh read FRefresh write FRefresh default cerSwitchEditorPage;
property Mode: TCodeExplorerMode read FMode write FMode default cemCategory;
property OptionsFilename: string read FOptionsFilename write FOptionsFilename;
property FollowCursor: boolean read FFollowCursor write FFollowCursor default true;
property Categories: TCodeExplorerCategories read FCategories write FCategories default DefaultCodeExplorerCategories;
// Figures
property Figures: TCEFigureCategories read FFigures write FFigures default DefaultCodeExplorerFigureCategories;
property LongProcLineCount: integer read FLongProcLineCount write FLongProcLineCount default DefaultFigLongProcLineCount;
property LongParamListCount: integer read FLongParamListCount write FLongParamListCount default DefaultFigLongParamListCount;
property NestedProcCount: integer read FNestedProcCount write FNestedProcCount default DefaultFigNestedProcCount;
property FigureCharConst: boolean read FFigureCharConst write FFigureCharConst default DefaultFigureCharConst;
property NotFigureConstants: TAvgLvlTree read FNotFigureConstants;
end;
{ TCodeExplorerDlg }
@ -140,7 +182,20 @@ const
'Variables',
'Constants',
'Properties',
'Procedures'
'Procedures',
'Figures'
);
CEFigureCategoryNames: array[TCEFigureCategory] of string = (
'LongProcs',
'LongParamLists',
'EmptyProcs',
'NestedProcs',
'UnnamedConsts',
'PublishedPropWithoutDefault',
'UnsortedClassVisibility',
'EmptyClassSections',
'UnsortedClassMembers',
'ToDos'
);
var
@ -152,6 +207,8 @@ function CodeExplorerRefreshNameToEnum(const s: string): TCodeExplorerRefresh;
function CodeExplorerModeNameToEnum(const s: string): TCodeExplorerMode;
function CodeExplorerCategoryNameToEnum(const s: string): TCodeExplorerCategory;
function CodeExplorerLocalizedString(const c: TCodeExplorerCategory): string;
function CodeExplorerFigureNameToEnum(const s: string): TCEFigureCategory;
function CodeExplorerLocalizedString(const c: TCEFigureCategory): string;
implementation
@ -160,21 +217,21 @@ implementation
function CodeExplorerRefreshNameToEnum(const s: string): TCodeExplorerRefresh;
begin
for Result:=Low(TCodeExplorerRefresh) to High(TCodeExplorerRefresh) do
if CompareText(CodeExplorerRefreshNames[Result],s)=0 then exit;
if SysUtils.CompareText(CodeExplorerRefreshNames[Result],s)=0 then exit;
Result:=cerDefault;
end;
function CodeExplorerModeNameToEnum(const s: string): TCodeExplorerMode;
begin
for Result:=Low(TCodeExplorerMode) to High(TCodeExplorerMode) do
if CompareText(CodeExplorerModeNames[Result],s)=0 then exit;
if SysUtils.CompareText(CodeExplorerModeNames[Result],s)=0 then exit;
Result:=cemCategory;
end;
function CodeExplorerCategoryNameToEnum(const s: string): TCodeExplorerCategory;
begin
for Result:=FirstCodeExplorerCategory to High(TCodeExplorerCategory) do
if CompareText(CodeExplorerCategoryNames[Result],s)=0 then exit;
if SysUtils.CompareText(CodeExplorerCategoryNames[Result],s)=0 then exit;
Result:=cecTypes;
end;
@ -187,6 +244,31 @@ begin
cecConstants: Result:=lisCEConstants;
cecProcedures: Result:=lisCEProcedures;
cecProperties: Result:=lisCEProperties;
cecFigures: Result:=lisCEFigures;
else Result:='?';
end;
end;
function CodeExplorerFigureNameToEnum(const s: string): TCEFigureCategory;
begin
for Result:=low(TCEFigureCategory) to High(TCEFigureCategory) do
if SysUtils.CompareText(CEFigureCategoryNames[Result],s)=0 then exit;
Result:=cefcLongProcs;
end;
function CodeExplorerLocalizedString(const c: TCEFigureCategory): string;
begin
case c of
cefcLongProcs: Result:=lisCELongProcedures;
cefcLongParamLists: Result:=lisCEManyParameters;
cefcEmptyProcs: Result:=lisCEEmptyProcedures;
cefcNestedProcs: Result:=lisCEManyNestedProcedures;
cefcUnnamedConsts: Result:=lisCEUnnamedConstants;
cefcPublishedPropWithoutDefault: Result:=lisCEPublishedPropertyWithoutDefault;
cefcUnsortedClassVisibility: Result:=lisCEUnsortedVisibility;
cefcEmptyClassSections: Result:=lisCEEmptyClassSections;
cefcUnsortedClassMembers: Result:=lisCEUnsortedMembers;
cefcToDos: Result:=lisCEToDos;
else Result:='?';
end;
end;
@ -212,11 +294,14 @@ constructor TCodeExplorerOptions.Create;
begin
FOptionsFilename:=
AppendPathDelim(GetPrimaryConfigPath)+'codeexploreroptions.xml';
FNotFigureConstants:=TAvgLvlTree.Create(TListSortCompare(@CompareAtom));
Clear;
end;
destructor TCodeExplorerOptions.Destroy;
begin
ClearNotFigureConstants;
FreeAndNil(FNotFigureConstants);
inherited Destroy;
end;
@ -226,11 +311,20 @@ begin
FRefresh:=cerDefault;
FFollowCursor:=true;
FCategories:=DefaultCodeExplorerCategories;
FFigures:=DefaultCodeExplorerFigureCategories;
FLongProcLineCount:=DefaultFigLongProcLineCount;
FLongParamListCount:=DefaultFigLongParamListCount;
FNestedProcCount:=DefaultFigNestedProcCount;
FFigureCharConst:=DefaultFigureCharConst;
ClearNotFigureConstants;
AddNotFigureConstant('0');
AddNotFigureConstant('1');
end;
procedure TCodeExplorerOptions.Assign(Source: TPersistent);
var
Src: TCodeExplorerOptions;
List: TStrings;
begin
if Source is TCodeExplorerOptions then begin
Src:=TCodeExplorerOptions(Source);
@ -238,6 +332,17 @@ begin
FMode:=Src.Mode;
FFollowCursor:=Src.FollowCursor;
FCategories:=Src.Categories;
FFigures:=Src.Figures;
FLongProcLineCount:=Src.LongProcLineCount;
FLongParamListCount:=Src.LongParamListCount;
FNestedProcCount:=Src.NestedProcCount;
FFigureCharConst:=Src.FigureCharConst;
List:=Src.CreateListOfNotFigureConstants;
try
SetListOfNotFigureConstants(List);
finally
List.Free;
end;
end else
inherited Assign(Source);
end;
@ -286,6 +391,9 @@ procedure TCodeExplorerOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig;
const Path: string);
var
c: TCodeExplorerCategory;
f: TCEFigureCategory;
CurPath: String;
List: TStringList;
begin
Clear;
FRefresh:=CodeExplorerRefreshNameToEnum(
@ -299,12 +407,47 @@ begin
if XMLConfig.GetValue(Path+'Categories/'+CodeExplorerCategoryNames[c],
c in DefaultCodeExplorerCategories) then
Include(FCategories,c);
FFigures:=[];
for f:=low(TCEFigureCategory) to high(TCEFigureCategory) do
begin
CurPath:=Path+'Figures/'+CEFigureCategoryNames[f]+'/';
if XMLConfig.GetValue(CurPath+'Show',f in DefaultCodeExplorerFigureCategories)
then
Include(FFigures,f);
case f of
cefcLongProcs:
FLongProcLineCount:=XMLConfig.GetValue(CurPath+'LineCount/Value',
DefaultFigLongProcLineCount);
cefcLongParamLists:
FLongParamListCount:=XMLConfig.GetValue(CurPath+'Count/Value',
DefaultFigLongParamListCount);
cefcNestedProcs:
FNestedProcCount:=XMLConfig.GetValue(CurPath+'Count/Value',
DefaultFigNestedProcCount);
cefcUnnamedConsts:
begin
FFigureCharConst:=XMLConfig.GetValue(CurPath+'CharConsts/Value',
DefaultFigureCharConst);
// save NotFigureConstants
List:=TStringList.Create;
try
LoadStringList(XMLConfig,List,CurPath+'Ignore');
SetListOfNotFigureConstants(List);
finally
List.Free;
end;
end;
end;
end;
end;
procedure TCodeExplorerOptions.SaveToXMLConfig(XMLConfig: TXMLConfig;
const Path: string);
var
c: TCodeExplorerCategory;
f: TCEFigureCategory;
CurPath: String;
List: TStrings;
begin
XMLConfig.SetDeleteValue(Path+'Refresh/Value',
CodeExplorerRefreshNames[FRefresh],
@ -317,6 +460,109 @@ begin
for c:=FirstCodeExplorerCategory to high(TCodeExplorerCategory) do
XMLConfig.SetDeleteValue(Path+'Categories/'+CodeExplorerCategoryNames[c],
c in FCategories,c in DefaultCodeExplorerCategories);
for f:=low(TCEFigureCategory) to high(TCEFigureCategory) do
begin
CurPath:=Path+'Figures/'+CEFigureCategoryNames[f]+'/';
XMLConfig.SetDeleteValue(CurPath+'Show',
f in FFigures,f in DefaultCodeExplorerFigureCategories);
case f of
cefcLongProcs:
XMLConfig.SetDeleteValue(CurPath+'LineCount/Value',
FLongProcLineCount,DefaultFigLongProcLineCount);
cefcLongParamLists:
XMLConfig.SetDeleteValue(CurPath+'Count/Value',
FLongParamListCount,DefaultFigLongParamListCount);
cefcNestedProcs:
XMLConfig.SetDeleteValue(CurPath+'Count/Value',
FNestedProcCount,DefaultFigNestedProcCount);
cefcUnnamedConsts:
begin
XMLConfig.SetDeleteValue(CurPath+'CharConsts/Value',
FFigureCharConst,DefaultFigureCharConst);
// save NotFigureConstants
List:=CreateListOfNotFigureConstants;
try
SaveStringList(XMLConfig,List,CurPath+'Ignore');
finally
List.Free;
end;
end;
end;
end;
end;
function TCodeExplorerOptions.CreateListOfNotFigureConstants: TStrings;
var
AVLNode: TAvgLvlTreeNode;
i: Integer;
s: String;
begin
Result:=TStringList.Create;
AVLNode:=NotFigureConstants.FindLowest;
i:=0;
while AVLNode<>nil do begin
s:=GetAtomString(PChar(AVLNode.Data));
if s<>'' then begin
inc(i);
Result.Add(s);
end;
AVLNode:=NotFigureConstants.FindSuccessor(AVLNode);
end;
end;
procedure TCodeExplorerOptions.ClearNotFigureConstants;
var
AVLNode: TAvgLvlTreeNode;
s: String;
begin
s:='';
AVLNode:=FNotFigureConstants.FindLowest;
while AVLNode<>nil do begin
// decrease reference counter
Pointer(s):=AVLNode.Data;
s:='';
AVLNode:=FNotFigureConstants.FindSuccessor(AVLNode);
end;
if s='' then ; // omit fpc note
FNotFigureConstants.Clear;
end;
procedure TCodeExplorerOptions.SetListOfNotFigureConstants(List: TStrings);
var
i: Integer;
s: string;
begin
ClearNotFigureConstants;
for i:=0 to List.Count-1 do begin
s:=List[i];
if s='' then continue;
FNotFigureConstants.Add(Pointer(s));
// keep reference count
Pointer(s):=nil;
end;
end;
function TCodeExplorerOptions.NotFigureConstant(p: PChar): boolean;
begin
Result:=FNotFigureConstants.Find(p)<>nil;
end;
procedure TCodeExplorerOptions.AddNotFigureConstant(const Atom: string);
var
s: String;
begin
if NotFigureConstant(@Atom[1]) then exit;
s:=Atom;
FNotFigureConstants.Add(Pointer(s));
Pointer(s):=nil;
end;
function TCodeExplorerOptions.IsNotFigureConstantsDefault: boolean;
begin
Result:=(FNotFigureConstants.Count=2)
and NotFigureConstant('0')
and NotFigureConstant('1');
end;
{ TCodeExplorerDlg }

43
ide/codeexplorer.lfm
View File

@ -24,14 +24,14 @@ object CodeExplorerView: TCodeExplorerView
TabOrder = 0
object CodePage: TPage
Caption = 'CodePage'
ClientWidth = 207
ClientHeight = 489
ClientWidth = 209
ClientHeight = 476
object CodeTreeview: TTreeView
AnchorSideTop.Side = asrBottom
Left = 0
Height = 463
Height = 450
Top = 26
Width = 207
Width = 209
Align = alClient
BorderSpacing.Top = 1
HideSelection = False
@ -49,14 +49,14 @@ object CodeExplorerView: TCodeExplorerView
Left = 0
Height = 25
Top = 0
Width = 207
Width = 209
Align = alTop
BevelOuter = bvNone
ClientHeight = 25
ClientWidth = 207
ClientWidth = 209
TabOrder = 1
object OptionsSpeedButton: TSpeedButton
Left = 180
Left = 182
Height = 22
Hint = 'Options for CodeExplorer'
Top = 1
@ -69,7 +69,7 @@ object CodeExplorerView: TCodeExplorerView
ParentShowHint = False
end
object RefreshSpeedButton: TSpeedButton
Left = 132
Left = 134
Height = 22
Hint = 'Refresh CodeExplorer'
Top = 1
@ -82,7 +82,7 @@ object CodeExplorerView: TCodeExplorerView
ParentShowHint = False
end
object ModeSpeedButton: TSpeedButton
Left = 156
Left = 158
Height = 22
Top = 1
Width = 23
@ -101,7 +101,7 @@ object CodeExplorerView: TCodeExplorerView
Left = 0
Height = 23
Top = 0
Width = 130
Width = 132
Anchors = [akTop, akLeft, akRight]
AutoSelect = True
OnChange = CodeFilterEditChange
@ -112,8 +112,8 @@ object CodeExplorerView: TCodeExplorerView
end
object DirectivesPage: TPage
Caption = 'DirectivesPage'
ClientWidth = 207
ClientHeight = 489
ClientWidth = 209
ClientHeight = 476
object DirectivesFilterEdit: TEdit
AnchorSideLeft.Control = DirectivesPage
AnchorSideTop.Control = DirectivesPage
@ -122,7 +122,7 @@ object CodeExplorerView: TCodeExplorerView
Left = 0
Height = 23
Top = 0
Width = 207
Width = 209
Anchors = [akTop, akLeft, akRight]
OnChange = DirectivesFilterEditChange
TabOrder = 0
@ -132,13 +132,13 @@ object CodeExplorerView: TCodeExplorerView
AnchorSideTop.Control = DirectivesFilterEdit
AnchorSideTop.Side = asrBottom
Left = 0
Height = 465
Height = 452
Top = 24
Width = 207
Width = 209
Align = alBottom
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 1
DefaultItemHeight = 15
DefaultItemHeight = 19
PopupMenu = TreePopupmenu
ReadOnly = True
TabOrder = 1
@ -153,14 +153,21 @@ object CodeExplorerView: TCodeExplorerView
Height = 18
Width = 18
left = 64
top = 32
top = 64
end
object TreePopupmenu: TPopupMenu
left = 64
top = 72
top = 128
object MenuItem1: TMenuItem
Caption = 'New Item1'
Visible = False
end
end
object IdleTimer1: TIdleTimer
AutoEnabled = True
Interval = 500
OnTimer = IdleTimer1Timer
left = 64
top = 192
end
end

38
ide/codeexplorer.lrs
View File

@ -1,4 +1,4 @@
{ Dit is een automatisch aangemaakt lazarus broncode bestand }
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TCodeExplorerView','FORMDATA',[
'TPF0'#17'TCodeExplorerView'#16'CodeExplorerView'#4'Left'#3#31#3#6'Height'#3#5
@ -10,51 +10,53 @@ LazarusResources.Add('TCodeExplorerView','FORMDATA',[
+#2#3'Top'#2#2#5'Width'#3#215#0#5'Align'#7#8'alClient'#17'BorderSpacing.Top'#2
+#2#13'OnPageChanged'#7#23'MainNotebookPageChanged'#9'PageIndex'#2#1#8'TabOrd'
+'er'#2#0#0#5'TPage'#8'CodePage'#7'Caption'#6#8'CodePage'#11'ClientWidth'#3
+#207#0#12'ClientHeight'#3#233#1#0#9'TTreeView'#12'CodeTreeview'#18'AnchorSid'
+'eTop.Side'#7#9'asrBottom'#4'Left'#2#0#6'Height'#3#207#1#3'Top'#2#26#5'Width'
+#3#207#0#5'Align'#7#8'alClient'#17'BorderSpacing.Top'#2#1#13'HideSelection'#8
+#209#0#12'ClientHeight'#3#220#1#0#9'TTreeView'#12'CodeTreeview'#18'AnchorSid'
+'eTop.Side'#7#9'asrBottom'#4'Left'#2#0#6'Height'#3#194#1#3'Top'#2#26#5'Width'
+#3#209#0#5'Align'#7#8'alClient'#17'BorderSpacing.Top'#2#1#13'HideSelection'#8
+#6'Images'#7#10'Imagelist1'#9'PopupMenu'#7#13'TreePopupmenu'#8'ReadOnly'#9#16
+'RightClickSelect'#9#8'TabOrder'#2#0#10'OnDblClick'#7#20'CodeTreeviewDblClic'
+'k'#10'OnDeletion'#7#20'CodeTreeviewDeletion'#7'OnKeyUp'#7#17'CodeTreeviewKe'
+'yUp'#7'Options'#11#17'tvoAutoItemHeight'#21'tvoKeepCollapsedNodes'#11'tvoRe'
+'adOnly'#19'tvoRightClickSelect'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoS'
+'howRoot'#11'tvoToolTips'#22'tvoNoDoubleClickExpand'#0#0#0#6'TPanel'#23'Code'
+'TreeviewButtonPanel'#4'Left'#2#0#6'Height'#2#25#3'Top'#2#0#5'Width'#3#207#0
+'TreeviewButtonPanel'#4'Left'#2#0#6'Height'#2#25#3'Top'#2#0#5'Width'#3#209#0
+#5'Align'#7#5'alTop'#10'BevelOuter'#7#6'bvNone'#12'ClientHeight'#2#25#11'Cli'
+'entWidth'#3#207#0#8'TabOrder'#2#1#0#12'TSpeedButton'#18'OptionsSpeedButton'
+#4'Left'#3#180#0#6'Height'#2#22#4'Hint'#6#24'Options for CodeExplorer'#3'Top'
+'entWidth'#3#209#0#8'TabOrder'#2#1#0#12'TSpeedButton'#18'OptionsSpeedButton'
+#4'Left'#3#182#0#6'Height'#2#22#4'Hint'#6#24'Options for CodeExplorer'#3'Top'
+#2#1#5'Width'#2#23#7'Anchors'#11#5'akTop'#7'akRight'#0#5'Color'#7#9'clBtnFac'
+'e'#9'NumGlyphs'#2#0#7'OnClick'#7#23'OptionsSpeedButtonClick'#8'ShowHint'#9
+#14'ParentShowHint'#8#0#0#12'TSpeedButton'#18'RefreshSpeedButton'#4'Left'#3
+#132#0#6'Height'#2#22#4'Hint'#6#20'Refresh CodeExplorer'#3'Top'#2#1#5'Width'
+#134#0#6'Height'#2#22#4'Hint'#6#20'Refresh CodeExplorer'#3'Top'#2#1#5'Width'
+#2#23#7'Anchors'#11#5'akTop'#7'akRight'#0#5'Color'#7#9'clBtnFace'#9'NumGlyph'
+'s'#2#0#7'OnClick'#7#23'RefreshSpeedButtonClick'#8'ShowHint'#9#14'ParentShow'
+'Hint'#8#0#0#12'TSpeedButton'#15'ModeSpeedButton'#4'Left'#3#156#0#6'Height'#2
+'Hint'#8#0#0#12'TSpeedButton'#15'ModeSpeedButton'#4'Left'#3#158#0#6'Height'#2
+#22#3'Top'#2#1#5'Width'#2#23#7'Anchors'#11#5'akTop'#7'akRight'#0#5'Color'#7#9
+'clBtnFace'#9'NumGlyphs'#2#0#7'OnClick'#7#20'ModeSpeedButtonClick'#8'ShowHin'
+'t'#9#14'ParentShowHint'#8#0#0#5'TEdit'#14'CodeFilterEdit'#22'AnchorSideLeft'
+'.Control'#7#8'CodePage'#21'AnchorSideTop.Control'#7#8'CodePage'#23'AnchorSi'
+'deRight.Control'#7#8'CodePage'#20'AnchorSideRight.Side'#7#9'asrBottom'#4'Le'
+'ft'#2#0#6'Height'#2#23#3'Top'#2#0#5'Width'#3#130#0#7'Anchors'#11#5'akTop'#6
+'ft'#2#0#6'Height'#2#23#3'Top'#2#0#5'Width'#3#132#0#7'Anchors'#11#5'akTop'#6
+'akLeft'#7'akRight'#0#10'AutoSelect'#9#8'OnChange'#7#20'CodeFilterEditChange'
+#8'TabOrder'#2#0#4'Text'#6#14'CodeFilterEdit'#0#0#0#0#5'TPage'#14'Directives'
+'Page'#7'Caption'#6#14'DirectivesPage'#11'ClientWidth'#3#207#0#12'ClientHeig'
+'ht'#3#233#1#0#5'TEdit'#20'DirectivesFilterEdit'#22'AnchorSideLeft.Control'#7
+'Page'#7'Caption'#6#14'DirectivesPage'#11'ClientWidth'#3#209#0#12'ClientHeig'
+'ht'#3#220#1#0#5'TEdit'#20'DirectivesFilterEdit'#22'AnchorSideLeft.Control'#7
+#14'DirectivesPage'#21'AnchorSideTop.Control'#7#14'DirectivesPage'#23'Anchor'
+'SideRight.Control'#7#14'DirectivesPage'#20'AnchorSideRight.Side'#7#9'asrBot'
+'tom'#4'Left'#2#0#6'Height'#2#23#3'Top'#2#0#5'Width'#3#207#0#7'Anchors'#11#5
+'tom'#4'Left'#2#0#6'Height'#2#23#3'Top'#2#0#5'Width'#3#209#0#7'Anchors'#11#5
+'akTop'#6'akLeft'#7'akRight'#0#8'OnChange'#7#26'DirectivesFilterEditChange'#8
+'TabOrder'#2#0#4'Text'#6#20'DirectivesFilterEdit'#0#0#9'TTreeView'#18'Direct'
+'ivesTreeView'#21'AnchorSideTop.Control'#7#20'DirectivesFilterEdit'#18'Ancho'
+'rSideTop.Side'#7#9'asrBottom'#4'Left'#2#0#6'Height'#3#209#1#3'Top'#2#24#5'W'
+'idth'#3#207#0#5'Align'#7#8'alBottom'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akR'
+'ight'#8'akBottom'#0#17'BorderSpacing.Top'#2#1#17'DefaultItemHeight'#2#15#9
+'rSideTop.Side'#7#9'asrBottom'#4'Left'#2#0#6'Height'#3#196#1#3'Top'#2#24#5'W'
+'idth'#3#209#0#5'Align'#7#8'alBottom'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akR'
+'ight'#8'akBottom'#0#17'BorderSpacing.Top'#2#1#17'DefaultItemHeight'#2#19#9
+'PopupMenu'#7#13'TreePopupmenu'#8'ReadOnly'#9#8'TabOrder'#2#1#10'OnDblClick'
+#7#26'DirectivesTreeViewDblClick'#10'OnDeletion'#7#26'DirectivesTreeViewDele'
+'tion'#7'OnKeyUp'#7#23'DirectivesTreeViewKeyUp'#7'Options'#11#17'tvoAutoItem'
+'Height'#16'tvoHideSelection'#21'tvoKeepCollapsedNodes'#11'tvoReadOnly'#14't'
+'voShowButtons'#12'tvoShowLines'#11'tvoShowRoot'#11'tvoToolTips'#0#0#0#0#0#10
+'TImageList'#10'Imagelist1'#6'Height'#2#18#5'Width'#2#18#4'left'#2'@'#3'top'
+#2' '#0#0#10'TPopupMenu'#13'TreePopupmenu'#4'left'#2'@'#3'top'#2'H'#0#9'TMen'
+'uItem'#9'MenuItem1'#7'Caption'#6#9'New Item1'#7'Visible'#8#0#0#0#0
+#2'@'#0#0#10'TPopupMenu'#13'TreePopupmenu'#4'left'#2'@'#3'top'#3#128#0#0#9'T'
+'MenuItem'#9'MenuItem1'#7'Caption'#6#9'New Item1'#7'Visible'#8#0#0#0#10'TIdl'
+'eTimer'#10'IdleTimer1'#11'AutoEnabled'#9#8'Interval'#3#244#1#7'OnTimer'#7#15
+'IdleTimer1Timer'#4'left'#2'@'#3'top'#3#192#0#0#0#0
]);

392
ide/codeexplorer.pas
View File

@ -40,15 +40,15 @@ interface
uses
// FCL+LCL
Classes, SysUtils, LCLProc, LCLType, LResources, Forms, Controls, Graphics,
Dialogs, Buttons, ComCtrls, Menus, LDockCtrl, AvgLvlTree,
Dialogs, Buttons, ComCtrls, Menus, LDockCtrl, AvgLvlTree, StdCtrls, ExtCtrls,
// CodeTools
CodeToolManager, CodeAtom, CodeCache, CodeTree, KeywordFuncLists,
FindDeclarationTool, DirectivesTree, PascalParserTool,
BasicCodeTools, CodeToolManager, CodeAtom, CodeCache, CodeTree,
KeywordFuncLists, FindDeclarationTool, DirectivesTree, PascalParserTool,
// IDE Intf
LazIDEIntf, IDECommands, MenuIntf, SrcEditorIntf,
// IDE
LazarusIDEStrConsts, EnvironmentOpts, IDEOptionDefs, InputHistory, IDEProcs,
CodeExplOpts, StdCtrls, ExtCtrls;
TodoList, CodeExplOpts;
type
TCodeExplorerView = class;
@ -83,6 +83,7 @@ type
DirectivesFilterEdit: TEdit;
DirectivesPage: TPage;
DirectivesTreeView: TTreeView;
IdleTimer1: TIdleTimer;
Imagelist1: TImageList;
MainNotebook: TNotebook;
MenuItem1: TMenuItem;
@ -107,16 +108,18 @@ type
procedure DirectivesTreeViewKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DockingMenuItemClick(Sender: TObject);
procedure IdleTimer1Timer(Sender: TObject);
procedure JumpToMenuitemClick(Sender: TObject);
procedure MainNotebookPageChanged(Sender: TObject);
procedure ModeSpeedButtonClick(Sender: TObject);
procedure OptionsSpeedButtonClick(Sender: TObject);
procedure RefreshMenuitemClick(Sender: TObject);
procedure OnApplicationIdle(Sender: TObject; var Done: Boolean);
procedure RefreshSpeedButtonClick(Sender: TObject);
private
FCodeFilename: string;
fCategoryNodes: array[TCodeExplorerCategory] of TTreeNode;
fFigureNode: TTreeNode;
fFigureCatNodes: array[TCEFigureCategory] of TTreeNode;
FDirectivesFilename: string;
FFlags: TCodeExplorerViewFlags;
FLastCodeFilter: string;
@ -157,13 +160,18 @@ type
function GetCodeNodeImage(Tool: TFindDeclarationTool;
CodeNode: TCodeTreeNode): integer;
function GetDirectiveNodeImage(CodeNode: TCodeTreeNode): integer;
procedure CreateNodes(ACodeTool: TCodeTool; CodeNode: TCodeTreeNode;
procedure CreateIdentifierNodes(ACodeTool: TCodeTool; CodeNode: TCodeTreeNode;
ParentViewNode, InFrontViewNode: TTreeNode;
CreateSiblings: boolean);
procedure CreateNodes(ADirectivesTool: TDirectivesTool;
procedure CreateDirectiveNodes(ADirectivesTool: TDirectivesTool;
CodeNode: TCodeTreeNode;
ParentViewNode, InFrontViewNode: TTreeNode;
CreateSiblings: boolean);
procedure CreateFigures(Tool: TCodeTool);
function CreateFigureNode(Tool: TCodeTool; f: TCEFigureCategory): TTreeNode;
procedure FindFigureConstants(Tool: TCodeTool; CodeNode: TCodeTreeNode;
StartPos, EndPos: integer);
procedure FindFigureTodos(Tool: TCodeTool);
procedure SetCodeFilter(const AValue: string);
procedure SetCurrentPage(const AValue: TCodeExplorerPage);
procedure SetDirectivesFilter(const AValue: string);
@ -372,8 +380,6 @@ begin
{$IFNDEF EnableIDEDocking}
CEDockingIDEMenuCommand.Visible:=false;
{$ENDIF}
Application.AddOnIdleHandler(@OnApplicationIdle);
end;
procedure TCodeExplorerView.CodeExplorerViewDestroy(Sender: TObject);
@ -436,6 +442,12 @@ begin
ControlDocker.ShowDockingEditor;
end;
procedure TCodeExplorerView.IdleTimer1Timer(Sender: TObject);
begin
if (cevCheckOnIdle in FFlags) or (CodeExplorerOptions.Refresh=cerOnIdle) then
Refresh(true);
end;
procedure TCodeExplorerView.CodeExplorerViewCLOSE(Sender: TObject;
var CloseAction: TCloseAction);
begin
@ -474,13 +486,6 @@ begin
Refresh(true);
end;
procedure TCodeExplorerView.OnApplicationIdle(Sender: TObject; var Done: Boolean
);
begin
if (cevCheckOnIdle in FFlags) or (CodeExplorerOptions.Refresh=cerOnIdle) then
Refresh(true);
end;
procedure TCodeExplorerView.RefreshSpeedButtonClick(Sender: TObject);
begin
Refresh(true);
@ -597,7 +602,7 @@ begin
end;
end;
procedure TCodeExplorerView.CreateNodes(ACodeTool: TCodeTool;
procedure TCodeExplorerView.CreateIdentifierNodes(ACodeTool: TCodeTool;
CodeNode: TCodeTreeNode;
ParentViewNode, InFrontViewNode: TTreeNode; CreateSiblings: boolean);
var
@ -635,7 +640,7 @@ begin
ShowNode:=false;
end;
// don't show keyword nodes
// don't show modifier nodes
if CodeNode.Desc in [ctnIdentifier,ctnRangedArrayType,
ctnOpenArrayType,ctnOfConstType,ctnRangeType,ctnTypeType,ctnFileType,
ctnVariantType,ctnEnumerationType,ctnSetType,ctnProcedureType]
@ -724,13 +729,13 @@ begin
ViewNode:=ParentViewNode;
end;
if ShowChilds then
CreateNodes(ACodeTool,CodeNode.FirstChild,ViewNode,nil,true);
CreateIdentifierNodes(ACodeTool,CodeNode.FirstChild,ViewNode,nil,true);
if not CreateSiblings then break;
CodeNode:=CodeNode.NextBrother;
end;
end;
procedure TCodeExplorerView.CreateNodes(ADirectivesTool: TDirectivesTool;
procedure TCodeExplorerView.CreateDirectiveNodes(ADirectivesTool: TDirectivesTool;
CodeNode: TCodeTreeNode; ParentViewNode, InFrontViewNode: TTreeNode;
CreateSiblings: boolean);
var
@ -768,12 +773,345 @@ begin
InFrontViewNode:=ViewNode;
end;
if ShowChilds then
CreateNodes(ADirectivesTool,CodeNode.FirstChild,ViewNode,nil,true);
CreateDirectiveNodes(ADirectivesTool,CodeNode.FirstChild,ViewNode,nil,true);
if not CreateSiblings then break;
CodeNode:=CodeNode.NextBrother;
end;
end;
procedure TCodeExplorerView.CreateFigures(Tool: TCodeTool);
function AddCodeNode(f: TCEFigureCategory; CodeNode: TCodeTreeNode): TTreeNode;
var
Data: TViewNodeData;
FigTVNode: TTreeNode;
NodeText: String;
NodeImageIndCex: LongInt;
begin
Data:=TViewNodeData.Create(CodeNode);
FigTVNode:=CreateFigureNode(Tool,f);
NodeText:=GetCodeNodeDescription(Tool,CodeNode);
NodeImageIndCex:=GetCodeNodeImage(Tool,CodeNode);
Result:=CodeTreeview.Items.AddChild(FigTVNode,NodeText);
Result.Data:=Data;
Result.Text:=NodeText;
Result.ImageIndex:=NodeImageIndCex;
Result.SelectedIndex:=NodeImageIndCex;
end;
procedure CheckUnsortedClassMembers(ParentCodeNode: TCodeTreeNode);
var
LastNode: TCodeTreeNode;
LastIdentifier: string;
function NodeSorted(CodeNode: TCodeTreeNode): boolean;
var
p: PChar;
Identifier: String;
begin
Result:=true;
if (LastNode<>nil)
//and (not CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.MixMethodsAndProperties)
and (CodeNode.Desc<>LastNode.Desc) then begin
// sort variables then methods and properties
if (LastNode.Desc in [ctnProperty,ctnProcedure])
and not (CodeNode.Desc in [ctnProperty,ctnProcedure])
then begin
Result:=false;
end;
if (LastNode.Desc in [ctnProperty])
and (CodeNode.Desc in [ctnProcedure])
and (not CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.MixMethodsAndProperties)
then
Result:=false;
end;
p:=Tool.GetNodeIdentifier(CodeNode);
if p<>nil then
Identifier:=GetIdentifier(p)
else
Identifier:='';
if Result and (LastIdentifier<>'') and (Identifier<>'')
and (CodeNode.Desc=LastNode.Desc) then begin
// compare identifiers
if CompareIdentifiers(PChar(Identifier),PChar(LastIdentifier))>0 then
begin
Result:=false;
end;
end;
if not Result then begin
AddCodeNode(cefcUnsortedClassMembers,CodeNode);
end;
LastNode:=CodeNode;
LastIdentifier:=Identifier;
end;
var
CodeNode: TCodeTreeNode;
begin
CodeNode:=ParentCodeNode.FirstChild;
LastNode:=nil;
while CodeNode<>nil do begin
if CodeNode.Desc in AllIdentifierDefinitions then begin
if not NodeSorted(CodeNode) then exit;
// skip all variables in a group (e.g. Next,Prev:TNode)
while CodeNode.FirstChild=nil do
CodeNode:=CodeNode.NextBrother;
if CodeNode=nil then break;
end else if CodeNode.Desc in [ctnProperty,ctnProcedure] then
begin
if not NodeSorted(CodeNode) then exit;
end;
CodeNode:=CodeNode.NextBrother;
end;
end;
var
CodeNode: TCodeTreeNode;
LineCnt: LongInt;
i: integer;
f: TCEFigureCategory;
Figures: TCEFigureCategories;
ProcNode: TCodeTreeNode;
begin
CodeNode:=Tool.Tree.Root;
Figures:=CodeExplorerOptions.Figures;
while CodeNode<>nil do begin
case CodeNode.Desc of
ctnBeginBlock:
begin
if (cefcLongProcs in Figures)
and (CodeNode.Parent.Desc=ctnProcedure) then begin
LineCnt:=LineEndCount(Tool.Src,CodeNode.StartPos,CodeNode.EndPos,i);
if LineCnt>=CodeExplorerOptions.LongProcLineCount then
begin
ProcNode:=CodeNode.Parent;
AddCodeNode(cefcLongProcs,ProcNode);
end;
end;
if (cefcLongProcs in Figures)
and (CodeNode.Parent.Desc=ctnProcedure) then begin
Tool.MoveCursorToCleanPos(CodeNode.StartPos);
Tool.ReadNextAtom;// read begin
Tool.ReadNextAtom;
if Tool.CurPos.Flag=cafEnd then begin
// no code, maybe comments and directives (hidden code)
ProcNode:=CodeNode.Parent;
AddCodeNode(cefcEmptyProcs,ProcNode);
end;
end;
if (cefcUnnamedConsts in Figures)
and (not CodeNode.HasParentOfType(ctnBeginBlock)) then begin
FindFigureConstants(Tool,CodeNode,CodeNode.StartPos,CodeNode.EndPos);
end;
end;
ctnProcedure:
begin
if (cefcNestedProcs in Figures) then
begin
i:=0;
ProcNode:=CodeNode.FirstChild;
while ProcNode<>nil do begin
if ProcNode.Desc=ctnProcedure then
inc(i);
ProcNode:=ProcNode.NextBrother;
end;
if i>=CodeExplorerOptions.NestedProcCount then begin
AddCodeNode(cefcNestedProcs,CodeNode);
end;
end;
end;
ctnParameterList:
begin
if (cefcLongParamLists in Figures)
and (CodeNode.HasParentOfType(ctnInterface))
and (CodeNode.ChildCount>CodeExplorerOptions.LongParamListCount) then
begin
if (CodeNode.Parent.Desc=ctnProcedureHead)
and (CodeNode.Parent.Parent.Desc=ctnProcedure) then
begin
ProcNode:=CodeNode.Parent.Parent;
AddCodeNode(cefcLongParamLists,ProcNode);
end;
end;
end;
ctnProperty:
begin
if (cefcPublishedPropWithoutDefault in Figures)
and (CodeNode.Parent.Desc=ctnClassPublished)
and (not Tool.PropertyHasSpecifier(CodeNode,'default'))
then begin
AddCodeNode(cefcPublishedPropWithoutDefault,CodeNode);
end;
end;
ctnClassTypePrivate..ctnClassPublished:
begin
if (cefcUnsortedClassVisibility in Figures)
and (CodeNode.PriorBrother<>nil)
and (CodeNode.PriorBrother.Desc in AllClassBaseSections)
and (CodeNode.PriorBrother.Desc>CodeNode.Desc)
then begin
if (CodeNode.PriorBrother.Desc=ctnClassPublished)
and (CodeNode.PriorBrother.PriorBrother=nil) then
begin
// the first section can be published
end else begin
// the prior section was more visible
AddCodeNode(cefcUnsortedClassVisibility,CodeNode);
end;
end;
if (cefcUnsortedClassMembers in Figures)
then
CheckUnsortedClassMembers(CodeNode);
if (cefcEmptyClassSections in Figures)
and (CodeNode.FirstChild=nil) then begin
// empty class section
AddCodeNode(cefcEmptyClassSections,CodeNode);
end;
end;
end;
CodeNode:=CodeNode.Next;
end;
if cefcToDos in Figures then
FindFigureTodos(Tool);
// add numbers
for f:=low(TCEFigureCategory) to high(TCEFigureCategory) do begin
if fFigureCatNodes[f]=nil then continue;
fFigureCatNodes[f].Text:=
fFigureCatNodes[f].Text+' ('+IntToStr(fFigureCatNodes[f].Count)+')';
end;
end;
function TCodeExplorerView.CreateFigureNode(Tool: TCodeTool;
f: TCEFigureCategory): TTreeNode;
var
Data: TViewNodeData;
begin
if fFigureCatNodes[f]=nil then begin
if fFigureNode=nil then begin
fFigureNode:=CodeTreeview.Items.Add(nil, lisCEFigures);
Data:=TViewNodeData.Create(Tool.Tree.Root);
Data.Desc:=ctnNone;
Data.StartPos:=Tool.SrcLen;
fFigureNode.Data:=Data;
end;
fFigureCatNodes[f]:=CodeTreeview.Items.AddChild(fFigureNode,
CodeExplorerLocalizedString(f));
Data:=TViewNodeData.Create(Tool.Tree.Root);
Data.Desc:=ctnNone;
Data.StartPos:=Tool.SrcLen;
fFigureCatNodes[f].Data:=Data;
fFigureNode.Expanded:=true;
end;
Result:=fFigureCatNodes[f];
end;
procedure TCodeExplorerView.FindFigureConstants(Tool: TCodeTool;
CodeNode: TCodeTreeNode;
StartPos, EndPos: integer);
var
Data: TViewNodeData;
FigTVNode: TTreeNode;
NodeText: String;
NodeImageIndCex: LongInt;
TVNode: TTreeNode;
ProcNode: TCodeTreeNode;
OldPos: LongInt;
begin
if (StartPos<1) or (StartPos>=EndPos) then exit;
Tool.MoveCursorToCleanPos(StartPos);
while Tool.CurPos.StartPos<EndPos do begin
if Tool.Src[Tool.CurPos.StartPos] in ['''','#','0'..'9','$','%'] then begin
// a constant
if Tool.AtomIsEmptyStringConstant then begin
// ignore empty string constant ''
end else if Tool.AtomIsCharConstant
and (not CodeExplorerOptions.FigureCharConst) then
begin
// ignore char constants
end else begin
// add constant
Data:=TViewNodeData.Create(CodeNode);
Data.Desc:=ctnConstant;
Data.SubDesc:=ctnsNone;
Data.StartPos:=Tool.CurPos.StartPos;
Data.EndPos:=Tool.CurPos.EndPos;
FigTVNode:=CreateFigureNode(Tool,cefcUnnamedConsts);
NodeText:=Tool.GetAtom;
// add some context information
ProcNode:=CodeNode;
while (ProcNode<>nil) and (ProcNode.Desc<>ctnProcedure) do
ProcNode:=ProcNode.Parent;
if ProcNode<>nil then begin
OldPos:=Tool.CurPos.EndPos;
NodeText:=Format(lisCEIn, [NodeText, Tool.ExtractProcName(ProcNode, [
phpWithoutClassName])]);
Tool.MoveCursorToCleanPos(OldPos);
end;
NodeImageIndCex:=ImgIDConst;
TVNode:=CodeTreeview.Items.AddChild(FigTVNode,NodeText);
TVNode.Data:=Data;
TVNode.Text:=NodeText;
TVNode.ImageIndex:=NodeImageIndCex;
TVNode.SelectedIndex:=NodeImageIndCex;
end;
end;
Tool.ReadNextAtom;
end;
end;
procedure TCodeExplorerView.FindFigureTodos(Tool: TCodeTool);
var
Src: String;
p: Integer;
CommentEndPos: LongInt;
MagicStartPos: integer;
TextStartPos: integer;
TextEndPos: integer;
l: Integer;
SrcLen: Integer;
Data: TViewNodeData;
FigTVNode: TTreeNode;
NodeText: String;
NodeImageIndCex: LongInt;
TVNode: TTreeNode;
begin
Src:=Tool.Src;
SrcLen:=length(Src);
p:=1;
repeat
p:=FindNextComment(Src,p);
if p>SrcLen then break;
CommentEndPos:=FindCommentEnd(Src,p,Tool.Scanner.NestedComments);
if GetToDoComment(Src,p,CommentEndPos,MagicStartPos,TextStartPos,TextEndPos)
then begin
// add todo
Data:=TViewNodeData.Create(Tool.Tree.Root);
Data.Desc:=ctnConstant;
Data.SubDesc:=ctnsNone;
Data.StartPos:=p;
Data.EndPos:=MagicStartPos;
FigTVNode:=CreateFigureNode(Tool,cefcToDos);
l:=TextEndPos-TextStartPos;
if l>20 then l:=20;
NodeText:=TrimCodeSpace(copy(Src,TextStartPos,l));
NodeImageIndCex:=ImgIDConst;
TVNode:=CodeTreeview.Items.AddChild(FigTVNode,NodeText);
TVNode.Data:=Data;
TVNode.Text:=NodeText;
TVNode.ImageIndex:=NodeImageIndCex;
TVNode.SelectedIndex:=NodeImageIndCex;
end;
p:=CommentEndPos;
until p>SrcLen;
end;
procedure TCodeExplorerView.SetCodeFilter(const AValue: string);
begin
if CodeFilter=AValue then exit;
@ -922,6 +1260,7 @@ var
OldExpanded: TTreeNodeExpandedState;
ACodeTool: TCodeTool;
c: TCodeExplorerCategory;
f: TCEFigureCategory;
begin
if (FUpdateCount>0)
or (OnlyVisible and ((CurrentPage<>cepCode) or (not IsVisible))) then begin
@ -980,12 +1319,17 @@ begin
for c:=low(TCodeExplorerCategory) to high(TCodeExplorerCategory) do
fCategoryNodes[c]:=nil;
fFigureNode:=nil;
for f:=low(TCEFigureCategory) to high(TCEFigureCategory) do
fFigureCatNodes[f]:=nil;
if (ACodeTool=nil) or (ACodeTool.Tree=nil) or (ACodeTool.Tree.Root=nil) then
begin
CodeTreeview.Items.Clear;
end else begin
CodeTreeview.Items.Clear;
CreateNodes(ACodeTool,ACodeTool.Tree.Root,nil,nil,true);
CreateIdentifierNodes(ACodeTool,ACodeTool.Tree.Root,nil,nil,true);
CreateFigures(ACodeTool);
end;
// restore old expanded state
@ -1060,7 +1404,7 @@ begin
DirectivesTreeView.Items.Clear;
end else begin
DirectivesTreeView.Items.Clear;
CreateNodes(ADirectivesTool,ADirectivesTool.Tree.Root,nil,nil,true);
CreateDirectiveNodes(ADirectivesTool,ADirectivesTool.Tree.Root,nil,nil,true);
end;
// restore old expanded state
@ -1335,7 +1679,7 @@ const
ctnClassPublic,
ctnClassPublished : Result:=Desc-ctnClassTypePrivate;
else Result:=1000;
else Result:=10000;
end;
end;

12
ide/lazarusidestrconsts.pas
View File

@ -3685,6 +3685,7 @@ resourcestring
lisNewAncestors = 'New Ancestors';
lisCEModeShowCategories = 'Show Categories';
lisCEModeShowSourceNodes = 'Show Source Nodes';
lisCEIn = '%s in %s';
lisCEOCodeExplorer = 'CodeExplorer Options';
lisCEOUpdate = 'Update';
lisCEORefreshAutomatically = 'Refresh automatically';
@ -3700,6 +3701,7 @@ resourcestring
lisCEConstants = 'Constants';
lisCEProcedures = 'Procedures';
lisCEProperties = 'Properties';
lisCEFigures = 'Figures';
dlgCOMoveLevelDown = 'Move level down';
dlgCOMoveLevelUp = 'Move level up';
dlgCOMoveDown = 'Move down';
@ -4127,6 +4129,16 @@ resourcestring
lisUnusedUnits = 'Unused units';
lisRemoveSelectedUnits = 'Remove selected units';
lisRemoveAllUnits = 'Remove all units';
lisCELongProcedures = 'Long procedures';
lisCEManyParameters = 'Many parameters';
lisCEUnnamedConstants = 'Unnamed constants';
lisCEEmptyProcedures = 'Empty procedures';
lisCEManyNestedProcedures = 'Many nested procedures';
lisCEPublishedPropertyWithoutDefault = 'PublishedPropertyWithoutDefault';
lisCEUnsortedVisibility = 'Unsorted visibility';
lisCEUnsortedMembers = 'Unsorted members';
lisCEToDos = 'ToDos';
lisCEEmptyClassSections = 'Empty class sections';
implementation

68
ide/todolist.pas
View File

@ -174,6 +174,12 @@ type
var
frmTodo: TfrmTodo;
function IsToDoComment(const Src: string;
CommentStartPos, CommentEndPos: integer): boolean;
function GetToDoComment(const Src: string;
CommentStartPos, CommentEndPos: integer;
out MagicStartPos, TextStartPos, TextEndPos: integer): boolean;
implementation
function CompareTLScannedFiles(Data1, Data2: Pointer): integer;
@ -188,6 +194,68 @@ begin
TTLScannedFile(ScannedFile).Filename);
end;
function IsToDoComment(const Src: string;
CommentStartPos, CommentEndPos: integer): boolean;
var
StartPos: Integer;
EndPos: Integer;
begin
if CommentStartPos<1 then exit(false);
if CommentEndPos-CommentStartPos<5 then exit(false);
if Src[CommentStartPos]='/' then begin
StartPos:=CommentStartPos+1;
EndPos:=CommentEndPos-1;
end else if (Src[CommentStartPos]='{') then begin
StartPos:=CommentStartPos+1;
EndPos:=CommentEndPos-1;
end else if (CommentStartPos<length(Src)) and (Src[CommentStartPos]='(')
and (Src[CommentStartPos+1]='*') then begin
StartPos:=CommentStartPos+2;
EndPos:=CommentEndPos-2;
end else
exit(false);
while (StartPos<EndPos) and (Src[StartPos]=' ') do inc(StartPos);
if Src[StartPos]='#' then inc(StartPos);
if CompareIdentifiers(cTodoFlag,@Src[StartPos])<>0 then exit(false);
Result:=true;
end;
function GetToDoComment(const Src: string; CommentStartPos,
CommentEndPos: integer; out MagicStartPos, TextStartPos, TextEndPos: integer
): boolean;
var
StartPos: Integer;
EndPos: Integer;
begin
if CommentStartPos<1 then exit(false);
if CommentEndPos-CommentStartPos<5 then exit(false);
if Src[CommentStartPos]='/' then begin
StartPos:=CommentStartPos+1;
EndPos:=CommentEndPos-1;
end else if (Src[CommentStartPos]='{') then begin
StartPos:=CommentStartPos+1;
EndPos:=CommentEndPos-1;
end else if (CommentStartPos<length(Src)) and (Src[CommentStartPos]='(')
and (Src[CommentStartPos+1]='*') then begin
StartPos:=CommentStartPos+2;
EndPos:=CommentEndPos-2;
end else
exit(false);
while (StartPos<EndPos) and (Src[StartPos]=' ') do inc(StartPos);
MagicStartPos:=StartPos;
if Src[StartPos]='#' then inc(StartPos);
if CompareIdentifiers(cAltTodoFLag,@Src[StartPos])<>0 then exit(false);
TextStartPos:=StartPos+length(cTodoFlag);
while (TextStartPos<EndPos) and (Src[TextStartPos]=' ') do inc(TextStartPos);
if Src[TextStartPos]=':' then begin
inc(TextStartPos);
while (TextStartPos<EndPos) and (Src[TextStartPos]=' ') do inc(TextStartPos);
end;
TextEndPos:=EndPos;
while (TextEndPos>TextStartPos) and (Src[TextEndPos-1]=' ') do dec(TextEndPos);
Result:=true;
end;
{ TfrmTodo }
constructor TfrmTodo.Create(AOwner: TComponent);