From d261f58365399c270c5cba9468dae2e6728f67aa Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 19 Jun 2003 16:36:35 +0000 Subject: [PATCH] started codeexplorer git-svn-id: trunk@4289 - --- components/codetools/allcodetoolunits.pp | 15 +- components/codetools/codetoolmanager.pas | 40 +- components/codetools/finddeclarationtool.pas | 7 +- components/codetools/pascalparsertool.pas | 1106 ------------------ components/codetools/stdcodetools.pas | 54 +- ide/ideoptiondefs.pas | 4 +- ide/mainbar.pas | 1 - ide/unitdependencies.pas | 5 +- lcl/comctrls.pp | 44 +- lcl/include/statusbar.inc | 3 +- lcl/include/treeview.inc | 87 ++ packager/pkggraphexplorer.pas | 97 +- 12 files changed, 210 insertions(+), 1253 deletions(-) diff --git a/components/codetools/allcodetoolunits.pp b/components/codetools/allcodetoolunits.pp index eb294e4b17..f26f70ff83 100644 --- a/components/codetools/allcodetoolunits.pp +++ b/components/codetools/allcodetoolunits.pp @@ -15,12 +15,12 @@ interface uses MemCheck, - CodeToolManager, CustomCodeTool, PascalParserTool, FindDeclarationTool, - StdCodeTools, MethodJumpTool, EventCodeTool, CodeCompletionTool, LinkScanner, - FindDeclarationCache, BasicCodeTools, CodeTree, CodeAtom, SourceChanger, - CodeToolMemManager, CodeCache, KeywordFuncLists, SourceLog, ExprEval, - DefineTemplates, FileProcs, AVL_Tree, CodeToolsStrConsts, - MultiKeyWordListTool, ResourceCodeTool, CodeToolsStructs; + CodeToolManager, CustomCodeTool, PascalParserTool, PascalReaderTool, + FindDeclarationTool, StdCodeTools, MethodJumpTool, EventCodeTool, + CodeCompletionTool, LinkScanner, FindDeclarationCache, BasicCodeTools, + CodeTree, CodeAtom, SourceChanger, CodeToolMemManager, CodeCache, + KeywordFuncLists, SourceLog, ExprEval, DefineTemplates, FileProcs, AVL_Tree, + CodeToolsStrConsts, MultiKeyWordListTool, ResourceCodeTool, CodeToolsStructs; implementation @@ -30,6 +30,9 @@ end. { ============================================================================= $Log$ + Revision 1.14 2003/06/19 16:36:35 mattias + started codeexplorer + Revision 1.13 2003/03/02 09:04:02 mattias added make resourcestring dialog, not finished diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index cdef7ab193..5a689adad6 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -212,11 +212,13 @@ type function GetUnitLinksForDirectory(const Directory: string): string; // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - // syntax checking (true on syntax is ok) + + // code exploring + function Explore(Code: TCodeBuffer; var ACodeTool: TCodeTool; + WithStatements: boolean): boolean; function CheckSyntax(Code: TCodeBuffer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer; var ErrorMsg: string): boolean; - + // compiler directives function GuessMisplacedIfdefEndif(Code: TCodeBuffer; X,Y: integer; var NewCode: TCodeBuffer; @@ -240,7 +242,7 @@ type function GuessUnclosedBlock(Code: TCodeBuffer; X,Y: integer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer): boolean; - + // method jumping function JumpToMethod(Code: TCodeBuffer; X,Y: integer; var NewCode: TCodeBuffer; @@ -258,7 +260,7 @@ type function GetIdentifierAt(Code: TCodeBuffer; X,Y: integer; var Identifier: string): boolean; - // resource string sections + // resourcestring sections function GatherResourceStringSections( Code: TCodeBuffer; X,Y: integer; CodePositions: TCodeXYPositions): boolean; @@ -739,6 +741,22 @@ begin Result:=Evaluator[ExternalMacroStart+'UnitLinks']; end; +function TCodeToolManager.Explore(Code: TCodeBuffer; + var ACodeTool: TCodeTool; WithStatements: boolean): boolean; +begin + Result:=false; + ACodeTool:=nil; + try + if InitCurCodeTool(Code) then begin + ACodeTool:=FCurCodeTool; + FCurCodeTool.Explore(WithStatements); + Result:=true; + end; + except + on e: Exception do Result:=HandleException(e); + end; +end; + function TCodeToolManager.InitCurCodeTool(Code: TCodeBuffer): boolean; var MainCode: TCodeBuffer; begin @@ -839,16 +857,10 @@ function TCodeToolManager.CheckSyntax(Code: TCodeBuffer; var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer; var ErrorMsg: string): boolean; // returns true on syntax correct +var + ACodeTool: TCodeTool; begin - Result:=false; - try - if InitCurCodeTool(Code) then begin - FCurCodeTool.BuildTree(false); - Result:=true; - end; - except - on e: Exception do Result:=HandleException(e); - end; + Result:=Explore(Code,ACodeTool,true); NewCode:=ErrorCode; NewX:=ErrorColumn; NewY:=ErrorLine; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 6255dd1af2..451890e1f2 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -21,7 +21,7 @@ Author: Mattias Gaertner Abstract: - TFindDeclarationTool enhances the TPascalParserTool with the ability + TFindDeclarationTool enhances the TPascalReaderTool with the ability to find the source position or code tree node of a declaration. @@ -78,7 +78,8 @@ uses {$ENDIF} Classes, SysUtils, CodeToolsStrConsts, CodeTree, CodeAtom, CustomCodeTool, SourceLog, KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache, AVL_Tree, - TypInfo, PascalParserTool, FileProcs, DefineTemplates, FindDeclarationCache; + TypInfo, PascalParserTool, PascalReaderTool, FileProcs, DefineTemplates, + FindDeclarationCache; type TFindDeclarationTool = class; @@ -459,7 +460,7 @@ type { TFindDeclarationTool } - TFindDeclarationTool = class(TPascalParserTool) + TFindDeclarationTool = class(TPascalReaderTool) private FInterfaceIdentifierCache: TInterfaceIdentifierCache; FOnFindUsedUnit: TOnFindUsedUnit; diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index ad0c96d6f5..9863eb4c50 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -46,17 +46,6 @@ uses LinkScanner, CodeCache, AVL_Tree, TypInfo, SourceChanger; type - {TExtractCodeAttribute = ( - // extract attributes: - phpWithComments, // extract comments and spaces - phpInUpperCase, // turn to uppercase - phpCommentsToSpace, // replace comments with a single space - // (default is to skip unnecessary space, - // e.g 'Do ;' normally becomes 'Do;' - // with this option you get 'Do ;') - ); - TExtractCodeAttributes = set of TExtractCodeAttribute;} - TProcHeadAttribute = ( // extract attributes: phpWithStart, // proc keyword e.g. 'function', 'class procedure' @@ -202,9 +191,6 @@ type ImplementationSectionFound: boolean; EndOfSourceFound: boolean; - function CleanPosIsInComment(CleanPos, CleanCodePosInFront: integer; - var CommentStart, CommentEnd: integer): boolean; - procedure BuildTree(OnlyInterfaceNeeded: boolean); virtual; procedure BuildTreeAndGetCleanPos(TreeRange: TTreeRange; const CursorPos: TCodeXYPosition; var CleanCursorPos: integer; @@ -215,83 +201,15 @@ type procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode; var FunctionResult: TCodeTreeNode); procedure BuildSubTree(CleanCursorPos: integer); virtual; - function FindDeepestExpandedNodeAtPos(CleanCursorPos: integer; - ExceptionOnNotFound: boolean): TCodeTreeNode; function DoAtom: boolean; override; - function ExtractNode(ANode: TCodeTreeNode; - Attr: TProcHeadAttributes): string; - function ExtractCode(StartPos, EndPos: integer; - Attr: TProcHeadAttributes): string; - - function ExtractPropType(PropNode: TCodeTreeNode; - InUpperCase, EmptyIfIndexed: boolean): string; - function ExtractProcName(ProcNode: TCodeTreeNode; - Attr: TProcHeadAttributes): string; - function ExtractProcHead(ProcNode: TCodeTreeNode; - Attr: TProcHeadAttributes): string; - function ExtractClassName(ClassNode: TCodeTreeNode; - InUpperCase: boolean): string; - function ExtractClassNameOfProcNode(ProcNode: TCodeTreeNode): string; - function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: string; - Attr: TProcHeadAttributes): TCodeTreeNode; - function FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode; - procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode); - function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode; - ProcSpec: TProcedureSpecifier): boolean; - function MoveCursorToPropType(PropNode: TCodeTreeNode): boolean; - function ProcNodeHasSpecifier(ProcNode: TCodeTreeNode; - ProcSpec: TProcedureSpecifier): boolean; - function GetProcNameIdentifier(ProcNode: TCodeTreeNode): PChar; - - function ExtractPropName(PropNode: TCodeTreeNode; - InUpperCase: boolean): string; - function ExtractProperty(PropNode: TCodeTreeNode; - Attr: TProcHeadAttributes): string; - function GetPropertyNameIdentifier(PropNode: TCodeTreeNode): PChar; - - function ExtractIdentCharsFromStringConstant( - StartPos, MaxLen: integer): string; - function ReadStringConstantValue(StartPos: integer): string; - - function FindVarNode(StartNode: TCodeTreeNode; - const UpperVarName: string): TCodeTreeNode; - function FindTypeNodeOfDefinition( - DefinitionNode: TCodeTreeNode): TCodeTreeNode; - function FindFirstNodeOnSameLvl(StartNode: TCodeTreeNode): TCodeTreeNode; function FindNextNodeOnSameLvl(StartNode: TCodeTreeNode): TCodeTreeNode; - function FindClassNode(StartNode: TCodeTreeNode; - const UpperClassName: string; - IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode; - function FindClassNodeInInterface(const UpperClassName: string; - IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode; - function FindFirstIdentNodeInClass(ClassNode: TCodeTreeNode): TCodeTreeNode; - function ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode): boolean; - - function GetSourceType: TCodeTreeNodeDesc; - function FindInterfaceNode: TCodeTreeNode; - function FindImplementationNode: TCodeTreeNode; - function FindInitializationNode: TCodeTreeNode; - function FindMainBeginEndNode: TCodeTreeNode; - function NodeHasParentOfType(ANode: TCodeTreeNode; NodeDesc: TCodeTreeNodeDesc): boolean; - function NodeIsInAMethod(Node: TCodeTreeNode): boolean; - function NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean; - function NodeIsFunction(ProcNode: TCodeTreeNode): boolean; - function NodeIsConstructor(ProcNode: TCodeTreeNode): boolean; - function NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode): boolean; - function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean; - function PropertyNodeHasParamList(PropNode: TCodeTreeNode): boolean; - function PropNodeIsTypeLess(PropNode: TCodeTreeNode): boolean; - function ProcNodeHasParamList(ProcNode: TCodeTreeNode): boolean; - procedure MoveCursorToUsesEnd(UsesNode: TCodeTreeNode); - procedure ReadPriorUsedUnit(var UnitNameAtom, InAtom: TAtomPosition); - constructor Create; destructor Destroy; override; end; @@ -736,14 +654,6 @@ begin end; end; -function TPascalParserTool.GetSourceType: TCodeTreeNodeDesc; -begin - if Tree.Root<>nil then - Result:=Tree.Root.Desc - else - Result:=ctnNone; -end; - function TPascalParserTool.KeyWordFuncClassReadTilEnd: boolean; // read til atom after next 'end' begin @@ -1699,38 +1609,6 @@ begin Result:=false; end; -function TPascalParserTool.ExtractNode(ANode: TCodeTreeNode; - Attr: TProcHeadAttributes): string; -begin - Result:=''; - ExtractProcHeadPos:=phepNone; - if (ANode=nil) or (ANode.StartPos<1) then exit; - InitExtraction; - // reparse the clean source - MoveCursorToNodeStart(ANode); - while (ANode.EndPos>CurPos.StartPos) - and (CurPos.StartPos<=SrcLen) do - ExtractNextAtom(true,Attr); - // copy memorystream to Result string - Result:=GetExtraction; -end; - -function TPascalParserTool.ExtractCode(StartPos, EndPos: integer; - Attr: TProcHeadAttributes): string; -begin - Result:=''; - ExtractProcHeadPos:=phepNone; - if (StartPos<1) or (StartPos>=EndPos) or (StartPos>SrcLen) then exit; - InitExtraction; - // reparse the clean source - MoveCursorToCleanPos(StartPos); - while (EndPos>CurPos.StartPos) - and (CurPos.StartPos<=SrcLen) do - ExtractNextAtom(true,Attr); - // copy memorystream to Result string - Result:=GetExtraction; -end; - function TPascalParserTool.KeyWordFuncSection: boolean; // parse section keywords (program, unit, interface, implementation, ...) @@ -3214,125 +3092,6 @@ begin Result:=true; end; -function TPascalParserTool.ExtractPropName(PropNode: TCodeTreeNode; - InUpperCase: boolean): string; -begin - Result:=''; - if (PropNode=nil) or (PropNode.Desc<>ctnProperty) then exit; - MoveCursorToNodeStart(PropNode); - ReadNextAtom; - if not UpAtomIs('PROPERTY') then exit; - ReadNextAtom; - AtomIsIdentifier(true); - if InUpperCase then - Result:=GetUpAtom - else - Result:=GetAtom; -end; - -function TPascalParserTool.ExtractPropType(PropNode: TCodeTreeNode; - InUpperCase, EmptyIfIndexed: boolean): string; -begin - Result:=''; - if (PropNode=nil) or (PropNode.Desc<>ctnProperty) then exit; - MoveCursorToNodeStart(PropNode); - ReadNextAtom; - if not UpAtomIs('PROPERTY') then exit; - ReadNextAtom; - AtomIsIdentifier(true); - ReadNextAtom; - if CurPos.Flag=cafEdgedBracketOpen then begin - if EmptyIfIndexed then exit; - ReadTilBracketClose(true); - ReadNextAtom; - end; - if CurPos.Flag in [cafSemicolon,cafEND] then exit; - if not (CurPos.Flag=cafColon) then - RaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]); - ReadNextAtom; - AtomIsIdentifier(true); - if InUpperCase then - Result:=GetUpAtom - else - Result:=GetAtom; -end; - -function TPascalParserTool.ExtractProperty(PropNode: TCodeTreeNode; - Attr: TProcHeadAttributes): string; -begin - Result:=''; - ExtractProcHeadPos:=phepNone; - if (PropNode=nil) or (PropNode.StartPos<1) or (PropNode.Desc<>ctnProperty) - then exit; - // start extraction - InitExtraction; - MoveCursorToNodeStart(PropNode); - ExtractNextAtom(false,Attr); - // parse 'property' - ExtractNextAtom(phpWithStart in Attr,Attr); - ExtractProcHeadPos:=phepStart; - // parse name - ExtractNextAtom(not (phpWithoutName in Attr),Attr); - ExtractProcHeadPos:=phepName; - // read parameter list - if (CurPos.Flag=cafEdgedBracketOpen) then - ReadParamList(false,true,Attr); - ExtractProcHeadPos:=phepParamList; - // read result type - if (CurPos.Flag=cafColon) then begin - ExtractNextAtom(phpWithResultType in Attr,Attr); - if not AtomIsIdentifier(false) then exit; - ExtractNextAtom(phpWithResultType in Attr,Attr); - ExtractProcHeadPos:=phepResultType; - end; - - // copy memorystream to Result string - Result:=GetExtraction; -end; - -function TPascalParserTool.ExtractProcName(ProcNode: TCodeTreeNode; - Attr: TProcHeadAttributes): string; -var - ProcHeadNode: TCodeTreeNode; -begin - Result:=''; - if [phpWithoutClassName,phpWithoutName]*Attr= - [phpWithoutClassName,phpWithoutName] - then - exit; - while (ProcNode<>nil) and (ProcNode.Desc<>ctnProcedure) do - ProcNode:=ProcNode.Parent; - if ProcNode=nil then exit; - ProcHeadNode:=ProcNode.FirstChild; - if (ProcHeadNode=nil) or (ProcHeadNode.StartPos<1) then exit; - MoveCursorToNodeStart(ProcHeadNode); - ReadNextAtom; - if not AtomIsIdentifier(false) then exit; - if phpInUpperCase in Attr then - Result:=GetUpAtom - else - Result:=GetAtom; - ReadNextAtom; - if (CurPos.Flag=cafPoint) then begin - if (phpWithoutClassName in Attr) then begin - Result:=''; - end else begin - if not (phpWithoutName in Attr) then - Result:=Result+'.'; - end; - ReadNextAtom; - if not (phpWithoutName in Attr) then begin - if phpInUpperCase in Attr then - Result:=Result+GetUpAtom - else - Result:=Result+GetAtom; - end; - end else begin - if phpWithoutName in Attr then - Result:=''; - end; -end; - procedure TPascalParserTool.RaiseCharExpectedButAtomFound(c: char); begin SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[c,GetAtom]); @@ -3434,226 +3193,6 @@ begin ReadNextAtom; end; -function TPascalParserTool.ExtractProcHead(ProcNode: TCodeTreeNode; - Attr: TProcHeadAttributes): string; -var - GrandPaNode: TCodeTreeNode; - TheClassName, s: string; - HasClassName, IsProcType: boolean; -begin - Result:=''; - ExtractProcHeadPos:=phepNone; - if (ProcNode=nil) or (ProcNode.StartPos<1) then exit; - if ProcNode.Desc=ctnProcedureHead then begin - ProcNode:=ProcNode.Parent; - if ProcNode=nil then exit; - end; - if not ProcNode.Desc in [ctnProcedure,ctnProcedureType] then exit; - IsProcType:=(ProcNode.Desc=ctnProcedureType); - if (phpAddClassname in Attr) then begin - GrandPaNode:=ProcNode.Parent; - if GrandPaNode=nil then exit; - GrandPaNode:=GrandPaNode.Parent; - if (GrandPaNode=nil) or (GrandPaNode.Desc<>ctnClass) then exit; - GrandPaNode:=GrandPaNode.Parent; - if GrandPaNode.Desc<>ctnTypeDefinition then exit; - MoveCursorToCleanPos(GrandPaNode.StartPos); - ReadNextAtom; - if not AtomIsIdentifier(false) then exit; - TheClassName:=GetAtom; - end; - InitExtraction; - // reparse the clean source - MoveCursorToNodeStart(ProcNode); - // parse procedure head = start + name + parameterlist + result type ; - ExtractNextAtom(false,Attr); - // read procedure start keyword - if (UpAtomIs('CLASS') or UpAtomIs('STATIC')) then - ExtractNextAtom((phpWithStart in Attr) - and not (phpWithoutClassKeyword in Attr),Attr); - if (UpAtomIs('PROCEDURE')) or (UpAtomIs('FUNCTION')) - or (UpAtomIs('CONSTRUCTOR')) or (UpAtomIs('DESTRUCTOR')) - or (UpAtomIs('OPERATOR')) then - ExtractNextAtom(phpWithStart in Attr,Attr) - else - exit; - ExtractProcHeadPos:=phepStart; - if not IsProcType then begin - // read name - if not AtomIsIdentifier(false) then exit; - ReadNextAtom; - HasClassName:=(CurPos.Flag=cafPoint); - UndoReadNextAtom; - if HasClassName then begin - // read class name - ExtractNextAtom(not (phpWithoutClassName in Attr),Attr); - // read '.' - ExtractNextAtom(not (phpWithoutClassName in Attr),Attr); - // read name - if not AtomIsIdentifier(false) then exit; - ExtractNextAtom(not (phpWithoutName in Attr),Attr); - end else begin - // read name - if not (phpAddClassname in Attr) then begin - ExtractNextAtom(not (phpWithoutName in Attr),Attr); - end else begin - // add class name - s:=TheClassName+'.'; - if not (phpWithoutName in Attr) then - s:=s+GetAtom; - ExtractNextAtom(false,Attr); - if phpInUpperCase in Attr then s:=UpperCaseStr(s); - if ExtractStreamEndIsIdentChar then - s:=' '+s; - ExtractMemStream.Write(s[1],length(s)); - end; - end; - ExtractProcHeadPos:=phepName; - end; - // read parameter list - if (CurPos.Flag=cafRoundBracketOpen) then - ReadParamList(false,true,Attr); - ExtractProcHeadPos:=phepParamList; - // read result type - if (CurPos.Flag=cafColon) then begin - ExtractNextAtom(phpWithResultType in Attr,Attr); - if not AtomIsIdentifier(false) then exit; - ExtractNextAtom(phpWithResultType in Attr,Attr); - ExtractProcHeadPos:=phepResultType; - end; - // read 'of object' - if UpAtomIs('OF') then begin - if IsProcType then begin - ExtractNextAtom(phpWithOfObject in Attr,Attr); - if not UpAtomIs('OBJECT') then exit; - ExtractNextAtom(phpWithOfObject in Attr,Attr); - end; - end; - // read semicolon - if CurPos.Flag=cafSemicolon then - ExtractNextAtom(true,Attr); - // read specifiers - if phpWithCallingSpecs in Attr then begin - while (CurPos.StartPos<=ProcNode.FirstChild.EndPos) do begin - if CurPos.Flag=cafSemicolon then begin - ExtractNextAtom(false,Attr); - end else begin - if (UpAtomIs('INLINE') or UpAtomIs('CDECL')) then begin - ExtractNextAtom(phpWithCallingSpecs in Attr,Attr); - ExtractMemStream.Write(';',1); - end - else if (CurPos.Flag=cafEdgedBracketOpen) then begin - ReadTilBracketClose(false); - ExtractNextAtom(false,Attr); - end else begin - ExtractNextAtom(false,Attr); - end; - end; - end; - end; - - // copy memorystream to Result string - Result:=GetExtraction; -end; - -function TPascalParserTool.ExtractClassName(ClassNode: TCodeTreeNode; - InUpperCase: boolean): string; -var Len: integer; -begin - if ClassNode<>nil then begin - if ClassNode.Desc=ctnClass then begin - ClassNode:=ClassNode.Parent; - if ClassNode=nil then begin - Result:=''; - exit; - end; - end; - Len:=1; - while (ClassNode.StartPos+Len<=SrcLen) - and (IsIdentChar[Src[ClassNode.StartPos+Len]]) do - inc(Len); - if InUpperCase then - Result:=copy(UpperSrc,ClassNode.StartPos,Len) - else - Result:=copy(Src,ClassNode.StartPos,Len); - end else - Result:=''; -end; - -function TPascalParserTool.FindProcNode(StartNode: TCodeTreeNode; - const AProcHead: string; Attr: TProcHeadAttributes): TCodeTreeNode; -// search in all next brothers for a Procedure Node with the Name ProcName -// if there are no further brothers and the parent is a section node -// ( e.g. 'interface', 'implementation', ...) or a class visibility node -// (e.g. 'public', 'private', ...) then the search will continue in the next -// section -var CurProcHead: string; -begin - Result:=StartNode; - while (Result<>nil) do begin - //writeln('TPascalParserTool.FindProcNode A "',NodeDescriptionAsString(Result.Desc),'"'); - if Result.Desc=ctnProcedure then begin - if (not ((phpIgnoreForwards in Attr) - and ((Result.SubDesc and ctnsForwardDeclaration)>0))) - and (not ((phpIgnoreProcsWithBody in Attr) - and (FindProcBody(Result)<>nil))) then - begin - CurProcHead:=ExtractProcHead(Result,Attr); - //writeln('TPascalParserTool.FindProcNode B "',CurProcHead,'" =? "',AProcHead,'"'); - if (CurProcHead<>'') - and (CompareTextIgnoringSpace(CurProcHead,AProcHead,false)=0) then - exit; - end; - end; - // next node - Result:=FindNextNodeOnSameLvl(Result); - end; -end; - -function TPascalParserTool.FindProcBody( - ProcNode: TCodeTreeNode): TCodeTreeNode; -begin - Result:=ProcNode; - if Result=nil then exit; - Result:=Result.FirstChild; - while Result<>nil do begin - if Result.Desc in [ctnBeginBlock,ctnAsmBlock] then - exit; - Result:=Result.NextBrother; - end; -end; - -function TPascalParserTool.FindVarNode(StartNode: TCodeTreeNode; - const UpperVarName: string): TCodeTreeNode; -begin - Result:=StartNode; - while Result<>nil do begin - if (Result.Desc=ctnVarDefinition) - and (CompareNodeIdentChars(Result,UpperVarName)=0) then - exit; - Result:=FindNextNodeOnSameLvl(Result); - end; -end; - -function TPascalParserTool.ExtractClassNameOfProcNode( - ProcNode: TCodeTreeNode): string; -var TheClassName: string; -begin - Result:=''; - if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure) then - ProcNode:=ProcNode.FirstChild; - if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureHead) then exit; - MoveCursorToNodeStart(ProcNode); - ReadNextAtom; - if not AtomIsIdentifier(false) then exit; - TheClassName:=GetAtom; - ReadNextAtom; - if (CurPos.Flag<>cafPoint) then exit; - ReadNextAtom; - if not AtomIsIdentifier(false) then exit; - Result:=TheClassName; -end; - function TPascalParserTool.FindFirstNodeOnSameLvl( StartNode: TCodeTreeNode): TCodeTreeNode; begin @@ -3686,112 +3225,6 @@ begin end; end; -function TPascalParserTool.FindClassNode(StartNode: TCodeTreeNode; - const UpperClassName: string; - IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode; -// search for types on same level, -// with type class and classname = SearchedClassName -var CurClassName: string; - ANode, CurClassNode: TCodeTreeNode; -begin - ANode:=StartNode; - Result:=nil; - while (ANode<>nil) do begin - if ANode.Desc=ctnTypeSection then begin - Result:=FindClassNode(ANode.FirstChild,UpperClassName,IgnoreForwards, - IgnoreNonForwards); - if Result<>nil then exit; - end else if ANode.Desc=ctnTypeDefinition then begin - CurClassNode:=ANode.FirstChild; - if (CurClassNode<>nil) and (CurClassNode.Desc=ctnClass) then begin - if (not (IgnoreForwards - and ((CurClassNode.SubDesc and ctnsForwardDeclaration)>0))) - and (not (IgnoreNonForwards - and ((CurClassNode.SubDesc and ctnsForwardDeclaration)=0))) - then begin - MoveCursorToNodeStart(ANode); - ReadNextAtom; - CurClassName:=GetUpAtom; - if UpperClassName=CurClassName then begin - Result:=CurClassNode; - exit; - end; - end; - end; - end; - // next node - if (ANode.NextBrother=nil) and (ANode.Parent<>nil) - and (ANode.Parent.NextBrother<>nil) - and (ANode.Parent.Desc in (AllCodeSections+AllClassSections)) then - ANode:=ANode.Parent.NextBrother.FirstChild - else - ANode:=ANode.NextBrother; - end; -end; - -function TPascalParserTool.FindClassNodeInInterface( - const UpperClassName: string; - IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode; -begin - Result:=Tree.Root; - if Result=nil then exit; - if Result.Desc=ctnUnit then begin - Result:=Result.NextBrother; - if Result=nil then exit; - end; - Result:=FindClassNode(Result.FirstChild,UpperClassName, - IgnoreForwards, IgnoreNonForwards); -end; - -function TPascalParserTool.FindFirstIdentNodeInClass( - ClassNode: TCodeTreeNode): TCodeTreeNode; -begin - Result:=nil; - if (ClassNode=nil) then exit; - BuildSubTreeForClass(ClassNode); - Result:=ClassNode.FirstChild; - while (Result<>nil) and (Result.FirstChild=nil) do - Result:=Result.NextBrother; - if Result=nil then exit; - Result:=Result.FirstChild; -end; - -function TPascalParserTool.FindInterfaceNode: TCodeTreeNode; -begin - Result:=Tree.Root; - while (Result<>nil) and (Result.Desc<>ctnInterface) do - Result:=Result.NextBrother; -end; - -function TPascalParserTool.FindImplementationNode: TCodeTreeNode; -begin - Result:=Tree.Root; - while (Result<>nil) and (Result.Desc<>ctnImplementation) do - Result:=Result.NextBrother; -end; - -function TPascalParserTool.FindInitializationNode: TCodeTreeNode; -begin - Result:=Tree.Root; - while (Result<>nil) and (Result.Desc<>ctnInitialization) do - Result:=Result.NextBrother; -end; - -function TPascalParserTool.FindMainBeginEndNode: TCodeTreeNode; -begin - Result:=Tree.Root; - if (Result=nil) then exit; - if (Result.Desc=ctnProgram) then - Result:=Result.LastChild - else begin - Result:=FindImplementationNode; - if Result<>nil then - Result:=Result.LastChild; - end; - if Result=nil then exit; - if Result.Desc<>ctnBeginBlock then Result:=nil; -end; - function TPascalParserTool.NodeHasParentOfType(ANode: TCodeTreeNode; NodeDesc: TCodeTreeNodeDesc): boolean; begin @@ -3803,157 +3236,6 @@ begin Result:=(ANode<>nil); end; -function TPascalParserTool.NodeIsInAMethod(Node: TCodeTreeNode): boolean; -begin - Result:=false; - while (Node<>nil) do begin - if (Node.Desc=ctnProcedure) then begin - if NodeIsMethodBody(Node) then begin - Result:=true; - exit; - end; - end; - Node:=Node.Parent; - end; -end; - -function TPascalParserTool.NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean; -begin - Result:=false; - if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure) then begin - - // ToDo: ppu, ppw, dcu - - MoveCursorToNodeStart(ProcNode.FirstChild); // ctnProcedureHead - ReadNextAtom; - if not AtomIsIdentifier(false) then exit; - ReadNextAtom; - if (CurPos.Flag<>cafPoint) then exit; - Result:=true; - exit; - end; -end; - -function TPascalParserTool.NodeIsFunction(ProcNode: TCodeTreeNode): boolean; -begin - Result:=false; - if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit; - MoveCursorToNodeStart(ProcNode); - ReadNextAtom; - if UpAtomIs('CLASS') then ReadNextAtom; - Result:=UpAtomIs('FUNCTION'); -end; - -function TPascalParserTool.NodeIsConstructor(ProcNode: TCodeTreeNode): boolean; -begin - Result:=false; - if (ProcNode=nil) then exit; - if ProcNode.Desc=ctnProcedureHead then - ProcNode:=ProcNode.Parent; - if ProcNode.Desc<>ctnProcedure then exit; - MoveCursorToNodeStart(ProcNode); - ReadNextAtom; - Result:=UpAtomIs('CONSTRUCTOR'); -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; -begin - Result:=false; - if CleanPos>SrcLen then exit; - if CleanCodePosInFront>CleanPos then - SaveRaiseException( - 'TPascalParserTool.CleanPosIsInComment CleanCodePosInFront>CleanPos'); - MoveCursorToCleanPos(CleanCodePosInFront); - repeat - ReadNextAtom; - if CurPos.StartPos>CleanPos then begin - // CleanPos between two atoms -> parse space between for comments - CommentStart:=CleanCodePosInFront; - CommentEnd:=CurPos.StartPos; - if CommentEnd>SrcLen then CommentEnd:=SrcLen+1; - while CommentStart0) do begin - case Src[CurCommentPos] of - '{': if Scanner.NestedComments then inc(CommentLvl); - '}': dec(CommentLvl); - end; - inc(CurCommentPos); - end; - end; - '/': // Delphi comment - if (CurCommentPosSrc[CurCommentPos]) then - inc(CurCommentPos); - end else - break; - '(': // old turbo pascal comment - if (CurCommentPos'*') or (Src[CurCommentPos]<>')')) - do - inc(CurCommentPos); - inc(CurCommentPos); - end else - break; - end; - if (CurCommentPos>CommentStart) and (CleanPos=CommentEnd) - or (not (IsSpaceChar[Src[CommentStart]])); - end else begin - break; - end; - end; - end else if CurPos.EndPos>CleanPos then begin - // CleanPos not in a comment - exit; - end; - CleanCodePosInFront:=CurPos.EndPos; - until CurPos.StartPos>=SrcLen; -end; - procedure TPascalParserTool.BuildTreeAndGetCleanPos( TreeRange: TTreeRange; const CursorPos: TCodeXYPosition; var CleanCursorPos: integer; BuildTreeFlags: TBuildTreeFlags; @@ -4006,23 +3288,6 @@ begin CleanCursorPos:=-1; end; -function TPascalParserTool.FindTypeNodeOfDefinition( - DefinitionNode: TCodeTreeNode): TCodeTreeNode; -// for example: 'var a,b,c: integer;' only c has a type child -begin - Result:=DefinitionNode; - while (Result<>nil) - and (Result.Desc in AllIdentifierDefinitions) do begin - if (Result.FirstChild<>nil) then begin - Result:=Result.FirstChild; - if (Result<>nil) and (not (Result.Desc in AllPascalTypes)) then - Result:=nil; - exit; - end; - Result:=Result.NextBrother; - end; -end; - function TPascalParserTool.ReadTilTypeOfProperty( PropertyNode: TCodeTreeNode): boolean; begin @@ -4067,360 +3332,6 @@ begin ReadNextAtom; end; -function TPascalParserTool.PropertyIsDefault(PropertyNode: TCodeTreeNode - ): boolean; -begin - Result:=false; - if (PropertyNode=nil) or (PropertyNode.Desc<>ctnProperty) then exit; - MoveCursorToCleanPos(PropertyNode.EndPos); - ReadPriorAtom; - if (CurPos.Flag<>cafSemicolon) then exit; - ReadPriorAtom; - Result:=UpAtomIs('DEFAULT'); -end; - -function TPascalParserTool.PropertyNodeHasParamList(PropNode: TCodeTreeNode - ): boolean; -begin - - // ToDo: ppu, ppw, dcu - - Result:=false; - MoveCursorToNodeStart(PropNode); - ReadNextAtom; // read 'property' - ReadNextAtom; // read name - ReadNextAtom; - Result:=(CurPos.Flag=cafEdgedBracketOpen); -end; - -function TPascalParserTool.PropNodeIsTypeLess(PropNode: TCodeTreeNode - ): boolean; -begin - - // ToDo: ppu, ppw, dcu - - Result:=false; - MoveCursorToNodeStart(PropNode); - ReadNextAtom; // read 'property' - ReadNextAtom; // read name - ReadNextAtom; - if CurPos.Flag=cafEdgedBracketOpen then begin - ReadTilBracketClose(true); - ReadNextAtom; - end; - Result:=(CurPos.Flag<>cafColon); -end; - -function TPascalParserTool.ProcNodeHasParamList(ProcNode: TCodeTreeNode - ): boolean; -begin - - // ToDo: ppu, ppw, dcu - - Result:=false; - if ProcNode.Desc=ctnProcedure then - ProcNode:=ProcNode.FirstChild; - MoveCursorToNodeStart(ProcNode); - ReadNextAtom; // read name - ReadNextAtom; - if AtomIsChar('.') then begin - ReadNextAtom; - ReadNextAtom; - end; - Result:=AtomIsChar('('); -end; - -procedure TPascalParserTool.MoveCursorToUsesEnd(UsesNode: TCodeTreeNode); -begin - if (UsesNode=nil) or (UsesNode.Desc<>ctnUsesSection) then - RaiseException('[TPascalParserTool.MoveCursorToUsesEnd] ' - +'internal error: invalid UsesNode'); - // search backwards through the uses section - MoveCursorToCleanPos(UsesNode.EndPos); - ReadPriorAtom; // read ';' - if not AtomIsChar(';') then - RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); -end; - -procedure TPascalParserTool.ReadPriorUsedUnit(var UnitNameAtom, - InAtom: TAtomPosition); -begin - ReadPriorAtom; // read unitname - if AtomIsStringConstant then begin - InAtom:=CurPos; - ReadPriorAtom; // read 'in' - if not UpAtomIs('IN') then - RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsKeywordIn,GetAtom]); - ReadPriorAtom; // read unitname - end else - InAtom.StartPos:=-1; - AtomIsIdentifier(true); - UnitNameAtom:=CurPos; -end; - -procedure TPascalParserTool.MoveCursorToFirstProcSpecifier( - ProcNode: TCodeTreeNode); -// After the call, -// CurPos will stand on the first proc specifier or on a semicolon -begin - if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then begin - SaveRaiseException('Internal Error in' - +' TPascalParserTool.MoveCursorFirstProcSpecifier: ' - +' (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure)'); - end; - MoveCursorToNodeStart(ProcNode.FirstChild); - ReadNextAtom; - if AtomIsIdentifier(false) then begin - // read name - ReadNextAtom; - if (CurPos.Flag=cafPoint) then begin - // read method name - ReadNextAtom; - ReadNextAtom; - end; - end; - if (CurPos.Flag=cafRoundBracketOpen) then begin - // read paramlist - ReadTilBracketClose(false); - ReadNextAtom; - end; - if (CurPos.Flag=cafColon) then begin - // read function result type - ReadNextAtom; - ReadNextAtom; - end; - // CurPos now stands on the first proc specifier or on a semicolon -end; - -function TPascalParserTool.MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode; - ProcSpec: TProcedureSpecifier): boolean; -begin - MoveCursorToFirstProcSpecifier(ProcNode); - while (CurPos.StartPos<=ProcNode.FirstChild.EndPos) do begin - if CurPos.Flag=cafSemicolon then begin - ReadNextAtom; - end else begin - if UpAtomIs(ProcedureSpecifierNames[ProcSpec]) then begin - Result:=true; - exit; - end; - if (CurPos.Flag=cafEdgedBracketOpen) then begin - ReadTilBracketClose(false); - ReadNextAtom; - end else if UpAtomIs('MESSAGE') then begin - ReadNextAtom; - ReadConstant(true,false,[]); - end else if UpAtomIs('EXTERNAL') then begin - ReadNextAtom; - if CurPos.Flag<>cafSemicolon then begin - if not UpAtomIs('NAME') then - ReadConstant(true,false,[]); - if UpAtomIs('NAME') or UpAtomIs('INDEX') then begin - ReadNextAtom; - ReadConstant(true,false,[]); - end; - end; - end else begin - ReadNextAtom; - end; - end; - end; - Result:=false; -end; - -function TPascalParserTool.MoveCursorToPropType(PropNode: TCodeTreeNode - ): boolean; -begin - Result:=false; - if (PropNode=nil) or (PropNode.Desc<>ctnProperty) then exit; - MoveCursorToNodeStart(PropNode); - ReadNextAtom; - if not UpAtomIs('PROPERTY') then exit; - ReadNextAtom; - AtomIsIdentifier(true); - ReadNextAtom; - if CurPos.Flag=cafEdgedBracketOpen then begin - ReadTilBracketClose(true); - ReadNextAtom; - end; - if CurPos.Flag in [cafSemicolon,cafEND] then exit; - if not (CurPos.Flag=cafColon) then - RaiseExceptionFmt(ctsStrExpectedButAtomFound,[':',GetAtom]); - ReadNextAtom; - AtomIsIdentifier(true); -end; - -function TPascalParserTool.ProcNodeHasSpecifier(ProcNode: TCodeTreeNode; - ProcSpec: TProcedureSpecifier): boolean; -begin - - // ToDo: ppu, ppw, dcu - - Result:=MoveCursorToProcSpecifier(ProcNode,ProcSpec); -end; - -function TPascalParserTool.GetProcNameIdentifier(ProcNode: TCodeTreeNode - ): PChar; -begin - - // ToDo: ppu, ppw, dcu - - Result:=nil; - if ProcNode=nil then exit; - if ProcNode.Desc=ctnProcedure then begin - ProcNode:=ProcNode.FirstChild; - if ProcNode=nil then exit; - end; - MoveCursorToNodeStart(ProcNode); - ReadNextAtom; - if not AtomIsIdentifier(false) then exit; - Result:=@Src[CurPos.StartPos]; - ReadNextAtom; - if not AtomIsChar('.') then exit; - ReadNextAtom; - Result:=@Src[CurPos.StartPos]; -end; - -function TPascalParserTool.GetPropertyNameIdentifier(PropNode: TCodeTreeNode - ): PChar; -begin - - // ToDo: ppu, ppw, dcu - - Result:=nil; - if PropNode=nil then exit; - MoveCursorToNodeStart(PropNode); - ReadNextAtom; // read 'propery' - ReadNextAtom; // read name - Result:=@Src[CurPos.StartPos]; -end; - -function TPascalParserTool.ExtractIdentCharsFromStringConstant( - StartPos, MaxLen: integer): string; -var - APos: Integer; - IdentStartPos: Integer; - IdentStr: String; -begin - Result:=''; - APos:=StartPos; - while APosAPos then begin - if IdentStartPos-APos+length(Result)>MaxLen then - IdentStartPos:=APos+MaxLen-length(Result); - IdentStr:=copy(Src,APos,IdentStartPos-APos); - if (Result<>'') and (IdentStr<>'') then - IdentStr[1]:=UpChars[IdentStr[1]]; - Result:=Result+IdentStr; - end; - APos:=IdentStartPos; - // skip non identifier chars - while (APos'''') - and (not IsIdentChar[Src[APos]]) - do - inc(APos); - until (APos>=SrcLen) or (Src[APos]='''') or (length(Result)>=MaxLen); - inc(APos); - end else - break; - end; -end; - -function TPascalParserTool.ReadStringConstantValue(StartPos: integer): string; -// reads a string constant and returns the resulting string -var - APos: Integer; - Run: Integer; - NumberStart: Integer; - ResultLen: Integer; - Number: Integer; -begin - Result:=''; - // first read and calculate the resulting length, then copy the chars - for Run:=1 to 2 do begin - APos:=StartPos; - ResultLen:=0; - while APos<=SrcLen do begin - if Src[APos]='''' then begin - // read string - inc(APos); - while APos<=SrcLen do begin - if (Src[APos]='''') then begin - if (APos255) then break; - inc(ResultLen); - if Run=2 then Result[ResultLen]:=chr(Number); - end; - end else - break; - end; - if Run=1 then SetLength(Result,ResultLen); - end; -end; - -function TPascalParserTool.ClassSectionNodeStartsWithWord( - ANode: TCodeTreeNode): boolean; -var p: integer; -begin - Result:=false; - if ANode=nil then exit; - p:=ANode.StartPos; - while (p255) then exit; SourceChangeCache.MainScanner:=Scanner; @@ -1486,7 +1476,7 @@ function TStandardCodeTool.GatherResourceStringSections( function SearchInUsesSection(UsesNode: TCodeTreeNode): boolean; var InAtom, UnitNameAtom: TAtomPosition; - NewCodeTool: TPascalParserTool; + NewCodeTool: TPascalReaderTool; ANode: TCodeTreeNode; NewCaret: TCodeXYPosition; begin @@ -2581,6 +2571,30 @@ begin end; end; +function TStandardCodeTool.Explore(WithStatements: boolean): boolean; + + procedure ExploreNode(ANode: TCodeTreeNode); + begin + if ANode=nil then exit; + case ANode.Desc of + ctnClass,ctnClassInterface: + BuildSubTreeForClass(ANode); + ctnProcedure,ctnProcedureHead: + BuildSubTreeForProcHead(ANode); + ctnBeginBlock: + if WithStatements then + BuildSubTreeForBeginBlock(ANode); + end; + ExploreNode(ANode.FirstChild); + ExploreNode(ANode.NextBrother); + end; + +begin + Result:=true; + BuildTree(false); + ExploreNode(Tree.Root); +end; + end. diff --git a/ide/ideoptiondefs.pas b/ide/ideoptiondefs.pas index f782b270eb..2caedf7e1a 100644 --- a/ide/ideoptiondefs.pas +++ b/ide/ideoptiondefs.pas @@ -38,6 +38,7 @@ uses type TNonModalIDEWindow = ( + // empty/none/undefined nmiwNone, nmiwMainIDEName, nmiwSourceNoteBookName, @@ -47,6 +48,7 @@ type nmiwClipbrdHistoryName, nmiwPkgGraphExplorer, nmiwProjectInspector, + // debugger nmiwDbgOutput, nmiwBreakPoints, nmiwWatches, @@ -62,7 +64,7 @@ const 'SourceNotebook', 'MessagesView', 'UnitDependencies', - 'CodeExplorer', + 'CodeExplorerView', 'ClipBrdHistory', 'PkgGraphExplorer', 'ProjectInspector', diff --git a/ide/mainbar.pas b/ide/mainbar.pas index 7bdae82b98..bbb29e0702 100644 --- a/ide/mainbar.pas +++ b/ide/mainbar.pas @@ -946,7 +946,6 @@ begin itmViewCodeExplorer := TMenuItem.Create(Self); itmViewCodeExplorer.Name:='itmViewCodeExplorer'; itmViewCodeExplorer.Caption := lisMenuViewCodeExplorer; - itmViewCodeExplorer.Enabled := false; mnuView.Add(itmViewCodeExplorer); mnuView.Add(CreateMenuSeparator); diff --git a/ide/unitdependencies.pas b/ide/unitdependencies.pas index 6fffdd842c..dfb5878e55 100644 --- a/ide/unitdependencies.pas +++ b/ide/unitdependencies.pas @@ -45,8 +45,9 @@ uses MemCheck, {$ENDIF} Classes, SysUtils, Controls, Forms, Dialogs, Buttons, ComCtrls, StdCtrls, - CodeToolManager, CodeCache, EnvironmentOpts, LResources, IDEOptionDefs, - LazarusIDEStrConsts, InputHistory, IDEProcs, Graphics, LCLType, FileCtrl; + Graphics, LCLType, FileCtrl, LResources, + CodeToolManager, CodeCache, + EnvironmentOpts, IDEOptionDefs, LazarusIDEStrConsts, InputHistory, IDEProcs; type diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index 65e7cdea54..38b012ee24 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -38,9 +38,9 @@ unit ComCtrls; interface uses - SysUtils, Classes, LCLStrConsts, Controls, Forms, LclLinux, LCLType, LCLProc, - StdCtrls, ExtCtrls, vclGlobals, lMessages, Menus, ImgList, GraphType, - Graphics, ToolWin, CommCtrl, Buttons, Math; + SysUtils, Classes, LCLStrConsts, LCLLinux, LCLType, LCLProc, AvgLvlTree, + Controls, Forms, StdCtrls, ExtCtrls, vclGlobals, LMessages, Menus, ImgList, + GraphType, Graphics, ToolWin, CommCtrl, Buttons, Math; type TStatusPanelStyle = (psText, psOwnerDraw); @@ -600,6 +600,7 @@ type property OnMouseUp; end; + { TToolBar } const @@ -1206,7 +1207,8 @@ type property Top: integer read GetTop; end; -{ TTreeNodes } + + { TTreeNodes } PNodeCache = ^TNodeCache; TNodeCache = record @@ -1296,7 +1298,7 @@ type read GetTopLvlItems write SetTopLvlItems; end; -{ TCustomTreeView } + { TCustomTreeView } TTreeViewState = ( tvsScrollbarChanged, @@ -1699,6 +1701,35 @@ type property OnStartDrag; property Items; end; + + + { TTreeNodeExpandedState } + { class to store and restore the expanded state of a TTreeView + The nodes are identified by their Text property. + + Usage example: + // save old expanded state + OldExpanded:=TTreeNodeExpandedState.Create(ATreeView); + ... change a lot of nodes ... + // restore old expanded state + OldExpanded.Apply(ATreeView); + OldExpanded.Free; + } + + TTreeNodeExpandedState = class + NodeText: string; + Childs: TAvgLvlTree; + constructor Create(FirstTreeNode: TTreeNode); + constructor Create(TreeView: TCustomTreeView); + destructor Destroy; override; + procedure Clear; + procedure CreateChildNodes(FirstTreeNode: TTreeNode); + procedure Apply(FirstTreeNode: TTreeNode); + procedure Apply(TreeView: TCustomTreeView); + end; + +function CompareExpandedNodes(Data1, Data2: Pointer): integer; +function CompareTextWithExpandedNode(Key, Data: Pointer): integer; function InitCommonControl(CC: Integer): Boolean; procedure CheckCommonControl(CC: Integer); @@ -1769,6 +1800,9 @@ end. { ============================================================================= $Log$ + Revision 1.79 2003/06/19 16:36:35 mattias + started codeexplorer + Revision 1.78 2003/06/18 11:21:06 mattias fixed taborder=0, implemented TabOrder Editor diff --git a/lcl/include/statusbar.inc b/lcl/include/statusbar.inc index a5b5e44567..a171ef21e8 100644 --- a/lcl/include/statusbar.inc +++ b/lcl/include/statusbar.inc @@ -27,8 +27,9 @@ begin FCanvas := TControlCanvas.Create; TControlCanvas(FCanvas).Control := Self; Color := clBtnFace; - Height:=20; + Anchors:=[akLeft,akRight,akBottom]; Align := alBottom; + Height:=20; end; diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index bb6f491ccf..a593fcecdb 100644 --- a/lcl/include/treeview.inc +++ b/lcl/include/treeview.inc @@ -38,7 +38,25 @@ const // maximum scroll range //MAX_SCROLL = 32767; +function CompareExpandedNodes(Data1, Data2: Pointer): integer; +var + Node1: TTreeNodeExpandedState; + Node2: TTreeNodeExpandedState; +begin + Node1:=TTreeNodeExpandedState(Data1); + Node2:=TTreeNodeExpandedState(Data2); + Result:=AnsiCompareText(Node1.NodeText,Node2.NodeText); +end; +function CompareTextWithExpandedNode(Key, Data: Pointer): integer; +var + NodeText: String; + Node: TTreeNodeExpandedState; +begin + NodeText:=String(Key); + Node:=TTreeNodeExpandedState(Data); + Result:=AnsiCompareText(NodeText,Node.NodeText); +end; procedure TreeViewError(const Msg: string); begin @@ -81,6 +99,75 @@ begin Result:=-1; end; +{ TTreeNodeExpandedState } + +constructor TTreeNodeExpandedState.Create(FirstTreeNode: TTreeNode); +begin + CreateChildNodes(FirstTreeNode); +end; + +constructor TTreeNodeExpandedState.Create(TreeView: TCustomTreeView); +begin + CreateChildNodes(TreeView.Items.GetFirstNode); +end; + +destructor TTreeNodeExpandedState.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TTreeNodeExpandedState.Clear; +begin + if Childs<>nil then begin + Childs.FreeAndClear; + FreeThenNil(Childs); + end; +end; + +procedure TTreeNodeExpandedState.CreateChildNodes(FirstTreeNode: TTreeNode); +var + ChildNode: TTreeNode; + NewExpandedNode: TTreeNodeExpandedState; +begin + if (FirstTreeNode<>nil) and (FirstTreeNode.Parent<>nil) then + NodeText:=FirstTreeNode.Parent.Text + else + NodeText:=''; + Clear; + ChildNode:=FirstTreeNode; + while ChildNode<>nil do begin + if ChildNode.Expanded then begin + if Childs=nil then Childs:=TAvgLvlTree.Create(@CompareExpandedNodes); + NewExpandedNode:=TTreeNodeExpandedState.Create(ChildNode.GetFirstChild); + Childs.Add(NewExpandedNode); + end; + ChildNode:=ChildNode.GetNextSibling; + end; +end; + +procedure TTreeNodeExpandedState.Apply(FirstTreeNode: TTreeNode); +var + ChildNode: TTreeNode; + ANode: TAvgLvlTreeNode; + ChildNodeText: String; +begin + if Childs=nil then exit; + ChildNode:=FirstTreeNode; + while ChildNode<>nil do begin + ChildNodeText:=ChildNode.Text; + ANode:=Childs.FindKey(PChar(ChildNodeText),@CompareTextWithExpandedNode); + ChildNode.Expanded:=ANode<>nil; + if ANode<>nil then + TTreeNodeExpandedState(ANode.Data).Apply(ChildNode.GetFirstChild); + ChildNode:=ChildNode.GetNextSibling; + end; +end; + +procedure TTreeNodeExpandedState.Apply(TreeView: TCustomTreeView); +begin + Apply(TreeView.Items.GetFirstNode); +end; { TTreeNode } diff --git a/packager/pkggraphexplorer.pas b/packager/pkggraphexplorer.pas index 60c8f01ae4..a485c6f1e2 100644 --- a/packager/pkggraphexplorer.pas +++ b/packager/pkggraphexplorer.pas @@ -103,97 +103,6 @@ implementation uses Math; -type - TExpandedNode = class - NodeText: string; - Childs: TAVLTree; - constructor Create(FirstTreeNode: TTreeNode); - destructor Destroy; override; - procedure Clear; - procedure CreateChildNodes(FirstTreeNode: TTreeNode); - procedure Apply(FirstTreeNode: TTreeNode); - end; - -function CompareExpandedNodes(Data1, Data2: Pointer): integer; -var - Node1: TExpandedNode; - Node2: TExpandedNode; -begin - Node1:=TExpandedNode(Data1); - Node2:=TExpandedNode(Data2); - Result:=AnsiCompareText(Node1.NodeText,Node2.NodeText); -end; - -function CompareTextWithExpandedNode(Key, Data: Pointer): integer; -var - NodeText: String; - Node: TExpandedNode; -begin - NodeText:=String(Key); - Node:=TExpandedNode(Data); - Result:=AnsiCompareText(NodeText,Node.NodeText); -end; - -{ TExpandedNode } - -constructor TExpandedNode.Create(FirstTreeNode: TTreeNode); -begin - CreateChildNodes(FirstTreeNode); -end; - -destructor TExpandedNode.Destroy; -begin - Clear; - inherited Destroy; -end; - -procedure TExpandedNode.Clear; -begin - if Childs<>nil then begin - Childs.FreeAndClear; - FreeThenNil(Childs); - end; -end; - -procedure TExpandedNode.CreateChildNodes(FirstTreeNode: TTreeNode); -var - ChildNode: TTreeNode; - NewExpandedNode: TExpandedNode; -begin - if (FirstTreeNode<>nil) and (FirstTreeNode.Parent<>nil) then - NodeText:=FirstTreeNode.Parent.Text - else - NodeText:=''; - Clear; - ChildNode:=FirstTreeNode; - while ChildNode<>nil do begin - if ChildNode.Expanded then begin - if Childs=nil then Childs:=TAVLTree.Create(@CompareExpandedNodes); - NewExpandedNode:=TExpandedNode.Create(ChildNode.GetFirstChild); - Childs.Add(NewExpandedNode); - end; - ChildNode:=ChildNode.GetNextSibling; - end; -end; - -procedure TExpandedNode.Apply(FirstTreeNode: TTreeNode); -var - ChildNode: TTreeNode; - ANode: TAVLTreeNode; - ChildNodeText: String; -begin - if Childs=nil then exit; - ChildNode:=FirstTreeNode; - while ChildNode<>nil do begin - ChildNodeText:=ChildNode.Text; - ANode:=Childs.FindKey(PChar(ChildNodeText),@CompareTextWithExpandedNode); - ChildNode.Expanded:=ANode<>nil; - if ANode<>nil then - TExpandedNode(ANode.Data).Apply(ChildNode.GetFirstChild); - ChildNode:=ChildNode.GetNextSibling; - end; -end; - { TPkgGraphExplorer } procedure TPkgGraphExplorer.PkgGraphExplorerResize(Sender: TObject); @@ -534,7 +443,7 @@ var NextViewNode: TTreeNode; HiddenNode: TAVLTreeNode; CurPkg: TLazPackage; - OldExpanded: TExpandedNode; + OldExpanded: TTreeNodeExpandedState; begin // rebuild internal sorted packages fSortedPackages.Clear; @@ -544,7 +453,7 @@ begin // rebuild the TreeView PkgTreeView.BeginUpdate; // save old expanded state - OldExpanded:=TExpandedNode.Create(PkgTreeView.Items.GetFirstNode); + OldExpanded:=TTreeNodeExpandedState.Create(PkgTreeView); // create first level CurIndex:=0; HiddenNode:=fSortedPackages.FindLowest; @@ -569,7 +478,7 @@ begin ViewNode:=NextViewNode; end; // restore old expanded state - OldExpanded.Apply(PkgTreeView.Items.GetFirstNode); + OldExpanded.Apply(PkgTreeView); OldExpanded.Free; // completed PkgTreeView.EndUpdate;