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

MG: added TListView notification from Vincent

Browse Source 
git-svn-id: trunk@3340 -
This commit is contained in:
lazarus 2002-09-14 08:38:06 +00:00
parent 7c2bb90b7b
commit 44e3418b75
8 changed files with 167 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
components/codetools/customcodetool.pas
View File

@ -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;

30
components/codetools/finddeclarationtool.pas
View File

@ -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);

87
components/codetools/pascalparsertool.pas
View File

@ -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,

65
components/codetools/stdcodetools.pas
View File

@ -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

2
ide/unitdependencies.pas
View File

@ -297,7 +297,7 @@ procedure TUnitNode.CreateChilds;
//var
// UsedInterfaceFilenames, UsedImplementation: TStrings;
begin
//CodeToolBoss.FindUsedUnits();
end;
end.

11
lcl/comctrls.pp
View File

@ -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.

8
lcl/include/listitems.inc
View File

@ -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

14
lcl/interfaces/gtk/gtklistviewcallback.inc
View File

@ -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);