From 44e3418b75def5105a0a5484e10c4784e18be0b7 Mon Sep 17 00:00:00 2001 From: lazarus Date: Sat, 14 Sep 2002 08:38:06 +0000 Subject: [PATCH] MG: added TListView notification from Vincent git-svn-id: trunk@3340 - --- components/codetools/customcodetool.pas | 12 +++ components/codetools/finddeclarationtool.pas | 30 ++----- components/codetools/pascalparsertool.pas | 87 ++++++++++++++++---- components/codetools/stdcodetools.pas | 65 ++++++++++++--- ide/unitdependencies.pas | 2 +- lcl/comctrls.pp | 11 ++- lcl/include/listitems.inc | 8 +- lcl/interfaces/gtk/gtklistviewcallback.inc | 14 ++-- 8 files changed, 167 insertions(+), 62 deletions(-) diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index db0c3cbe6f..94c256dfeb 100644 --- a/components/codetools/customcodetool.pas +++ b/components/codetools/customcodetool.pas @@ -156,6 +156,8 @@ type const AnAtom: shortstring): boolean; // 0=current, 1=prior current, ... function GetAtom: string; function GetUpAtom: string; + function GetAtom(Atom: TAtomPosition): string; + function GetUpAtom(Atom: TAtomPosition): string; function CompareNodeIdentChars(ANode: TCodeTreeNode; const AnUpperIdent: string): integer; function CompareSrcIdentifiers( @@ -598,6 +600,16 @@ begin Result:=copy(UpperSrc,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos); end; +function TCustomCodeTool.GetAtom(Atom: TAtomPosition): string; +begin + Result:=copy(Src,Atom.StartPos,Atom.EndPos-Atom.StartPos); +end; + +function TCustomCodeTool.GetUpAtom(Atom: TAtomPosition): string; +begin + Result:=copy(UpperSrc,Atom.StartPos,Atom.EndPos-Atom.StartPos); +end; + procedure TCustomCodeTool.ReadNextAtom; var c1, c2: char; CommentLvl: integer; diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 8bfbe7f4db..d37aa05eb9 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -2527,31 +2527,15 @@ function TFindDeclarationTool.FindIdentifierInUsesSection( search backwards through the uses section compare first the unit name, then load the unit and search there } -var InAtom, UnitNameAtom: TAtomPosition; +var + InAtom, UnitNameAtom: TAtomPosition; NewCodeTool: TFindDeclarationTool; OldInput: TFindDeclarationInput; begin Result:=false; - if (UsesNode=nil) or (UsesNode.Desc<>ctnUsesSection) then - RaiseException('[TFindDeclarationTool.FindIdentifierInUsesSection] ' - +'internal error: invalid UsesNode'); - // search backwards through the uses section - MoveCursorToCleanPos(UsesNode.EndPos); - ReadPriorAtom; // read ';' - if not AtomIsChar(';') then - RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]); + MoveCursorToUsesEnd(UsesNode); repeat - 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; + ReadPriorUsedUnit(UnitNameAtom, InAtom); if (fdfIgnoreUsedUnits in Params.Flags) then begin if CompareSrcIdentifiers(UnitNameAtom.StartPos,Params.Identifier) then begin @@ -2568,12 +2552,10 @@ begin NewCodeTool:=FindCodeToolForUsedUnit(UnitNameAtom,InAtom,false); if NewCodeTool=nil then begin MoveCursorToCleanPos(UnitNameAtom.StartPos); - RaiseExceptionFmt(ctsUnitNotFound,[copy(Src,UnitNameAtom.StartPos, - UnitNameAtom.EndPos-UnitNameAtom.StartPos)]); + RaiseExceptionFmt(ctsUnitNotFound,[GetAtom(UnitNameAtom)]); end else if NewCodeTool=Self then begin MoveCursorToCleanPos(UnitNameAtom.StartPos); - RaiseExceptionFmt(ctsIllegalCircleInUsedUnits,[copy(Src, - UnitNameAtom.StartPos,UnitNameAtom.EndPos-UnitNameAtom.StartPos)]); + RaiseExceptionFmt(ctsIllegalCircleInUsedUnits,[GetAtom(UnitNameAtom)]); end; // search the identifier in the interface of the used unit Params.Save(OldInput); diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index ca790e559d..4006685b35 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -171,6 +171,7 @@ type function CleanPosIsInComment(CleanPos, CleanCodePosInFront: integer; var CommentStart, CommentEnd: integer): boolean; + procedure BuildTree(OnlyInterfaceNeeded: boolean); virtual; procedure BuildTreeAndGetCleanPos(TreeRange: TTreeRange; CursorPos: TCodeXYPosition; var CleanCursorPos: integer); @@ -179,7 +180,9 @@ type procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode); virtual; procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode; var FunctionResult: TCodeTreeNode); + function DoAtom: boolean; override; + function ExtractPropName(PropNode: TCodeTreeNode; InUpperCase: boolean): string; function ExtractPropType(PropNode: TCodeTreeNode; @@ -194,35 +197,43 @@ type 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 ProcNodeHasSpecifier(ProcNode: TCodeTreeNode; + ProcSpec: TProcedureSpecifier): boolean; + 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 FindTypeNodeOfDefinition( - DefinitionNode: TCodeTreeNode): TCodeTreeNode; - function GetSourceType: TCodeTreeNodeDesc; + function NodeHasParentOfType(ANode: TCodeTreeNode; NodeDesc: TCodeTreeNodeDesc): boolean; function NodeIsInAMethod(Node: TCodeTreeNode): boolean; function NodeIsFunction(ProcNode: TCodeTreeNode): boolean; function NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode): boolean; function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean; - procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode); - function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode; - ProcSpec: TProcedureSpecifier): boolean; - function ProcNodeHasSpecifier(ProcNode: TCodeTreeNode; - ProcSpec: TProcedureSpecifier): boolean; - function ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode): boolean; + + procedure MoveCursorToUsesEnd(UsesNode: TCodeTreeNode); + procedure ReadPriorUsedUnit(var UnitNameAtom, InAtom: TAtomPosition); constructor Create; destructor Destroy; override; @@ -492,21 +503,39 @@ end; procedure TPascalParserTool.BuildSubTreeForClass(ClassNode: TCodeTreeNode); // reparse a quick parsed class and build the child nodes + + procedure RaiseClassNodeNil; + begin + SaveRaiseException( + 'TPascalParserTool.BuildSubTreeForClass: Classnode=nil'); + end; + + procedure RaiseClassDescInvalid; + begin + SaveRaiseException('[TPascalParserTool.BuildSubTreeForClass] ClassNode.Desc=' + +ClassNode.DescAsString); + end; + + procedure RaiseClassKeyWordExpected; + begin + SaveRaiseException( + 'TPascalParserTool.BuildSubTreeForClass:' + +' class/object keyword expected, but '+GetAtom+' found'); + end; + var OldPhase: integer; begin OldPhase:=CurrentPhase; CurrentPhase:=CodeToolPhaseParse; try if ClassNode=nil then - SaveRaiseException( - 'TPascalParserTool.BuildSubTreeForClass: Classnode=nil'); + RaiseClassNodeNil; if (ClassNode.FirstChild<>nil) or ((ClassNode.SubDesc and ctnsNeedJITParsing)=0) then // class already parsed exit; if ClassNode.Desc<>ctnClass then - SaveRaiseException('[TPascalParserTool.BuildSubTreeForClass] ClassNode.Desc=' - +ClassNode.DescAsString); + RaiseClassDescInvalid; // set CursorPos after class head MoveCursorToNodeStart(ClassNode); // parse @@ -519,9 +548,7 @@ begin ReadNextAtom; if UpAtomIs('PACKED') then ReadNextAtom; if (not UpAtomIs('CLASS')) and (not UpAtomIs('OBJECT')) then - SaveRaiseException( - 'TPascalParserTool.BuildSubTreeForClass:' - +' class/object keyword expected, but '+GetAtom+' found'); + RaiseClassKeyWordExpected; ReadNextAtom; if CurPos.Flag=cafRoundBracketOpen then // read inheritage @@ -3660,6 +3687,34 @@ begin Result:=UpAtomIs('DEFAULT'); 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, diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 3f0b2f3e5f..714640de35 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -89,6 +89,7 @@ type SourceChangeCache: TSourceChangeCache): boolean; function FindUsedUnits(var MainUsesSection, ImplementationUsesSection: TStrings): boolean; + function UsesSectionToFilenames(UsesNode: TCodeTreeNode): TStrings; // lazarus resources function FindNextIncludeInInitialization( @@ -521,27 +522,71 @@ end; function TStandardCodeTool.FindUsedUnits(var MainUsesSection, ImplementationUsesSection: TStrings): boolean; - - function UsesSectionToStrings(ANode: TCodeTreeNode): TStrings; - begin - Result:=TStringList.Create; - if ANode=nil then exit; - - end; - var MainUsesNode, ImplementatioUsesNode: TCodeTreeNode; begin + MainUsesSection:=nil; + ImplementationUsesSection:=nil; // find the uses sections BuildTree(false); MainUsesNode:=FindMainUsesSection; ImplementatioUsesNode:=FindImplementationUsesSection; // create lists - MainUsesSection:=UsesSectionToStrings(MainUsesNode); - ImplementationUsesSection:=UsesSectionToStrings(ImplementatioUsesNode); + try + MainUsesSection:=UsesSectionToFilenames(MainUsesNode); + ImplementationUsesSection:=UsesSectionToFilenames(ImplementatioUsesNode); + finally + FreeAndNil(MainUsesSection); + FreeAndNil(ImplementationUsesSection); + end; Result:=true; end; +{------------------------------------------------------------------------------ + function TStandardCodeTool.UsesSectionToFilenames(UsesNode: TCodeTreeNode + ): TStrings; + + Reads the uses section backwards and tries to find each unit file + The associated objects in the list will be the found codebuffers. + If no codebuffer was found/created then the filename will be the unit name + plus the 'in' extension. +------------------------------------------------------------------------------} +function TStandardCodeTool.UsesSectionToFilenames(UsesNode: TCodeTreeNode + ): TStrings; +var + InAtom, UnitNameAtom: TAtomPosition; + AnUnitName, AnUnitInFilename: string; + NewCode: TCodeBuffer; + UnitFilename: string; +begin + MoveCursorToUsesEnd(UsesNode); + Result:=TStringList.Create; + repeat + // read prior unit name + ReadPriorUsedUnit(UnitNameAtom, InAtom); + AnUnitName:=GetAtom(UnitNameAtom); + if InAtom.StartPos>0 then + AnUnitInFilename:=GetAtom(InAtom) + else + AnUnitInFilename:=''; + // find unit file + NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename); + if (NewCode=nil) then begin + // no source found + UnitFilename:=AnUnitName; + if AnUnitInFilename<>'' then + UnitFilename:=UnitFilename+' in '+AnUnitInFilename; + end else begin + // source found + UnitFilename:=NewCode.Filename; + end; + // add filename to list + Result.AddObject(UnitFilename,NewCode); + // read keyword 'uses' or comma + ReadPriorAtom; + until not AtomIsChar(','); +end; + function TStandardCodeTool.FindNextIncludeInInitialization( var LinkIndex: integer): TCodeBuffer; // LinkIndex < 0 -> search first diff --git a/ide/unitdependencies.pas b/ide/unitdependencies.pas index 63653ab157..efc5635648 100644 --- a/ide/unitdependencies.pas +++ b/ide/unitdependencies.pas @@ -297,7 +297,7 @@ procedure TUnitNode.CreateChilds; //var // UsedInterfaceFilenames, UsedImplementation: TStrings; begin - + //CodeToolBoss.FindUsedUnits(); end; end. diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index e1decb3b47..e13ecf275b 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -121,6 +121,7 @@ type property Visible; end; + { Custom draw } TCustomDrawTarget = (dtControl, dtItem, dtSubItem); @@ -130,7 +131,8 @@ type TCustomDrawState = set of TCustomDrawStateFlag; -{TListView} + { TListView } + TListItems = class; //forward declaration! TCustomListView = class; //forward declaration! TSortType = (stNone, stData, stText, stBoth); @@ -171,7 +173,7 @@ type property ImageIndex : Integer read FImageIndex write SetImageIndex default -1; end; - TListItems = class(TPersistent) + TListItems = class(TPersistent) private FOwner : TCustomListView; FItems : TList; @@ -272,7 +274,7 @@ type FScrollBars: TScrollStyle; FScrolledLeft: integer; // horizontal scrolled pixels (hidden pixels at top) FScrolledTop: integer; // vertical scrolled pixels (hidden pixels at top) - FSelected: TListItem; // temp copy of the selected item + FSelected: TListItem; // temp copy of the selected item FLastHorzScrollInfo: TScrollInfo; FLastVertScrollInfo: TScrollInfo; FUpdateCount: integer; @@ -1598,6 +1600,9 @@ end. { ============================================================================= $Log$ + Revision 1.46 2002/09/14 08:38:05 lazarus + MG: added TListView notification from Vincent + Revision 1.45 2002/09/13 16:07:20 lazarus Reverting statusbar changes. diff --git a/lcl/include/listitems.inc b/lcl/include/listitems.inc index 80913e1fee..328c3b24a2 100644 --- a/lcl/include/listitems.inc +++ b/lcl/include/listitems.inc @@ -80,7 +80,10 @@ var begin idx := FItems.Remove(AItem); if (idx >= 0) and (FOwner <> nil) - then FOwner.ItemDeleted(idx); + then begin + if FOwner.FSelected=AItem then FOwner.FSelected:=nil; + FOwner.ItemDeleted(idx); + end; end; {------------------------------------------------------------------------------} @@ -134,6 +137,9 @@ end; { ============================================================================= $Log$ + Revision 1.12 2002/09/14 08:38:06 lazarus + MG: added TListView notification from Vincent + Revision 1.11 2002/05/10 06:05:53 lazarus MG: changed license to LGPL diff --git a/lcl/interfaces/gtk/gtklistviewcallback.inc b/lcl/interfaces/gtk/gtklistviewcallback.inc index ca145a14cc..d13320818e 100644 --- a/lcl/interfaces/gtk/gtklistviewcallback.inc +++ b/lcl/interfaces/gtk/gtklistviewcallback.inc @@ -73,7 +73,7 @@ var NM: TNMListView; begin EventTrace('click-column', Adata); - msg.Msg := LM_NOTIFY; + msg.Msg := CN_NOTIFY; FillChar(NM, SizeOf(NM), 0); NM.hdr.hwndfrom := longint(AList); @@ -96,7 +96,7 @@ begin // Simulate move by remove and insert EventTrace('row-move', Adata); - msg.Msg := LM_NOTIFY; + msg.Msg := CN_NOTIFY; FillChar(NM, SizeOf(NM), 0); NM.hdr.hwndfrom := longint(AList); @@ -119,7 +119,7 @@ var NM: TNMListView; begin EventTrace('select-row', Adata); - msg.Msg := LM_NOTIFY; + msg.Msg := CN_NOTIFY; FillChar(NM, SizeOf(NM), 0); NM.hdr.hwndfrom := longint(AList); @@ -138,7 +138,7 @@ var NM: TNMListView; begin EventTrace('unselect-row', Adata); - msg.Msg := LM_NOTIFY; + msg.Msg := CN_NOTIFY; FillChar(NM, SizeOf(NM), 0); NM.hdr.hwndfrom := longint(AList); @@ -157,7 +157,7 @@ function gtkLVToggleFocusRow(AList: PGTKCList; AData: gPointer): GBoolean; cdecl //NM: TNMListView; begin EventTrace('toggle-focus-row', Adata); - //msg.Msg := LM_NOTIFY; + //msg.Msg := CN_NOTIFY; (* TODO: Do we need this? @@ -173,8 +173,8 @@ var n: Integer; begin EventTrace('select-all', Adata); - msg.Msg := LM_NOTIFY; - + msg.Msg := CN_NOTIFY; + ListView := TObject(AData) as TListView; FillChar(NM, SizeOf(NM), 0);