various fixes for TCustomMemo, RTTIControls, FindReferences

git-svn-id: trunk@6046 -
This commit is contained in:
mattias 2004-09-22 19:05:58 +00:00
parent 9bb1cdbb19
commit 08d727e283
13 changed files with 233 additions and 50 deletions

View File

@ -1341,7 +1341,13 @@ begin
InvalidateEditor;
if (Application<>nil) and FIdleHandlerConnected then
Application.RemoveOnIdleHandler(@OnApplicationIdle);
FreeThenNil(FLinkNotifier);
if FLinkNotifier<>nil then begin
if FTIObject is TComponent then begin
TComponent(FTIObject).RemoveFreeNotification(FLinkNotifier);
FTIObject:=nil;
end;
FreeThenNil(FLinkNotifier);
end;
FreeThenNil(FAliasValues);
FreeThenNil(FHook);
FreeThenNil(FCollectedValues);
@ -1362,17 +1368,26 @@ end;
procedure TCustomPropertyLink.SetObjectAndProperty(NewPersistent: TPersistent;
const NewPropertyName: string);
var
AComponent: TComponent;
begin
if (NewPropertyName<>'')
and ((length(NewPropertyName)>254) or (not IsValidIdent(NewPropertyName)))
then
raise Exception('TCustomPropertyLink.SetObjectAndProperty invalid identifier "'+NewPropertyName+'"');
if (NewPersistent=TIObject) and (NewPropertyName=TIPropertyName) then exit;
if FTIObject is TComponent then
TComponent(FTIObject).RemoveFreeNotification(FLinkNotifier);
if (FTIObject is TComponent) then begin
AComponent:=TComponent(FTIObject);
AComponent.RemoveFreeNotification(FLinkNotifier);
end;
FTIObject:=NewPersistent;
if FTIObject is TComponent then
TComponent(FTIObject).FreeNotification(FLinkNotifier);
if FTIObject is TComponent then begin
AComponent:=TComponent(FTIObject);
if not (csDestroying in AComponent.ComponentState) then
AComponent.FreeNotification(FLinkNotifier)
else
FTIObject:=nil;
end;
FTIPropertyName:=NewPropertyName;
InvalidateEditor;
LoadFromProperty;
@ -3097,7 +3112,7 @@ procedure TPropertyLinkNotifier.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Flink<>nil then FLink.Notification(AComponent,Operation);
if FLink<>nil then FLink.Notification(AComponent,Operation);
end;
constructor TPropertyLinkNotifier.Create(TheLink: TCustomPropertyLink);

View File

@ -190,6 +190,7 @@ function CompareStringPointerI(Data1, Data2: Pointer): integer;
procedure CheckList(List: TList; TestListNil, TestDoubles, TestNils: boolean);
procedure CheckEmptyListCut(List1, List2: TList);
function AnsiSearchInStringList(List: TStrings; const s: string): integer;
procedure ReverseList(List: TList);
implementation
@ -1112,6 +1113,21 @@ begin
while (Result>=0) and (AnsiCompareText(List[Result],s)<>0) do dec(Result);
end;
procedure ReverseList(List: TList);
var
i: Integer;
j: Integer;
begin
if List=nil then exit;
i:=0;
j:=List.Count-1;
while i<j do begin
List.Exchange(i,j);
inc(i);
dec(j);
end;
end;
{-------------------------------------------------------------------------------
function TrimSearchPath(const SearchPath, BaseDirectory: string): boolean;

View File

@ -990,7 +990,7 @@ destructor TMainIDE.Destroy;
begin
ToolStatus:=itExiting;
DebugLn('[TMainIDE.Destroy] A');
DebugLn('[TMainIDE.Destroy] A ');
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.Destroy A ');{$ENDIF}
FreeThenNil(ProjInspector);
@ -1031,7 +1031,7 @@ begin
FreeThenNil(EnvironmentOptions);
FreeThenNil(InputHistories);
DebugLn('[TMainIDE.Destroy] B -> inherited Destroy...');
DebugLn('[TMainIDE.Destroy] B -> inherited Destroy... ',ClassName);
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.Destroy B ');{$ENDIF}
FreeThenNil(SourceNotebook);
inherited Destroy;
@ -9305,8 +9305,8 @@ begin
end else begin
OwnerList:=PkgBoss.GetOwnersOfUnit(TargetUnitInfo.Filename);
if Options.Scope=frAllOpenProjectsAndPackages then begin
// TODO
PkgBoss.ExtendOwnerListWithUsedByOwners(OwnerList);
ReverseList(OwnerList);
end;
end;
ExtraFiles:=PkgBoss.GetSourceFilesOfOwners(OwnerList);
@ -10813,6 +10813,9 @@ end.
{ =============================================================================
$Log$
Revision 1.777 2004/09/22 19:05:58 mattias
various fixes for TCustomMemo, RTTIControls, FindReferences
Revision 1.776 2004/09/22 12:43:17 mattias
implemented searching and editing virtual units

View File

@ -2142,7 +2142,7 @@ begin
BuildPopupMenu;
// completion form
aCompletion := TSynCompletion.Create(AOwner);
aCompletion := TSynCompletion.Create(nil);
with aCompletion do
Begin
EndOfTokenChr:='()[]';
@ -2222,6 +2222,7 @@ begin
FSourceEditorList.Free;
Gotodialog.free;
FreeThenNil(aCompletion);
FreeThenNil(FHintTimer);
FreeThenNil(FHintWindow);
FreeThenNil(fCustomPopupMenuItems);

View File

@ -46,6 +46,7 @@ type
function AddUnitDependenciesForComponentClasses(const UnitFilename: string;
ComponentClassnames: TStrings): TModalResult; virtual; abstract;
function GetOwnersOfUnit(const UnitFilename: string): TList; virtual; abstract;
procedure ExtendOwnerListWithUsedByOwners(OwnerList: TList); virtual; abstract;
function GetSourceFilesOfOwners(OwnerList: TList): TStrings; virtual; abstract;
end;

View File

@ -1378,6 +1378,9 @@ type
end;
procedure WritePublishedProperties(Instance: TPersistent);
implementation
@ -1411,6 +1414,58 @@ begin
end;
end;
procedure WritePublishedProperties(Instance: TPersistent);
var
TypeInfo: PTypeInfo;
TypeData: PTypeData;
PropInfo: PPropInfo;
CurCount: integer;
begin
TypeInfo:=Instance.ClassInfo;
TypeData:=GetTypeData(TypeInfo);
debugln('WritePublishedProperties Instance=',HexStr(Cardinal(Instance),8),' ',Instance.ClassName,' TypeData^.PropCount=',dbgs(TypeData^.PropCount));
if Instance is TComponent then
debugln(' TComponent(Instance).Name=',TComponent(Instance).Name);
// read all properties and remove doubles
TypeInfo:=Instance.ClassInfo;
repeat
// read all property infos of current class
TypeData:=GetTypeData(TypeInfo);
// skip unitname
PropInfo:=(@TypeData^.UnitName+Length(TypeData^.UnitName)+1);
// read property count
CurCount:=PWord(PropInfo)^;
inc(Longint(PropInfo),SizeOf(Word));
debugln(' UnitName=',TypeData^.UnitName,' Type=',TypeInfo^.Name,' CurPropCount=',dbgs(CurCount));
{writeln('TPropInfoList.Create D ',CurCount,' TypeData^.ClassType=',HexStr(Cardinal(TypeData^.ClassType),8));
writeln('TPropInfoList.Create E ClassName="',TypeData^.ClassType.ClassName,'"',
' TypeInfo=',HexStr(Cardinal(TypeInfo),8),
' TypeData^.ClassType.ClassInfo=',HexStr(Cardinal(TypeData^.ClassType.ClassInfo),8),
' TypeData^.ClassType.ClassParent=',HexStr(Cardinal(TypeData^.ClassType.ClassParent),8),
' TypeData^.ParentInfo=',HexStr(Cardinal(TypeData^.ParentInfo),8),
'');
CurParent:=TypeData^.ClassType.ClassParent;
if CurParent<>nil then begin
writeln('TPropInfoList.Create F CurParent.ClassName=',CurParent.ClassName,
' CurParent.ClassInfo=',HexStr(Cardinal(CurParent.ClassInfo),8),
'');
end;}
// read properties
while CurCount>0 do begin
// point PropInfo to next propinfo record.
// Located at Name[Length(Name)+1] !
debugln(' Property ',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name);
PropInfo:=PPropInfo(pointer(@PropInfo^.Name)+PByte(@PropInfo^.Name)^+1);
dec(CurCount);
end;
TypeInfo:=TypeData^.ParentInfo;
if TypeInfo=nil then break;
until false;
end;
//------------------------------------------------------------------------------

View File

@ -34,7 +34,7 @@ Begin
Texts := StrPas(PChar(SelData^.data));
Assert(False, 'Trace:' + Texts);
Assert(False, 'Trace:0');
TEdit(Data).Caption := Texts;
TCustomEdit(Data).Caption := Texts;
Assert(False, 'Trace:1');
end;
gtk_drag_finish(Context,false,false,time);

View File

@ -144,8 +144,8 @@ type
private
protected
public
class procedure AppendText(const ACustomMemo: TCustomMemo; AText: string); override;
{$ifdef GTK1}
class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); override;
{$ifdef GTK1}
class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); override;
@ -637,50 +637,72 @@ begin
Result := WidgetGetSelStart(GetWidgetInfo(Pointer(ACustomEdit.Handle), true)^.CoreWidget);
end;
function TGtkWSCustomEdit.GetSelLength(const ACustomEdit: TCustomEdit): integer;
function TGtkWSCustomEdit.GetSelLength(const ACustomEdit: TCustomEdit): integer;
begin
with PGtkOldEditable(GetWidgetInfo(Pointer(ACustomEdit.Handle), true)^.CoreWidget)^ do begin
with PGtkOldEditable(GetWidgetInfo(Pointer(ACustomEdit.Handle), true)^.
CoreWidget)^ do
begin
Result:=Abs(integer(selection_end_pos)-integer(selection_start_pos));
end;
end;
procedure TGtkWSCustomEdit.SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase);
procedure TGtkWSCustomEdit.SetCharCase(const ACustomEdit: TCustomEdit;
NewCase: TEditCharCase);
begin
// TODO: implement me!
end;
procedure TGtkWSCustomEdit.SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode);
procedure TGtkWSCustomEdit.SetEchoMode(const ACustomEdit: TCustomEdit;
NewMode: TEchoMode);
begin
// XXX TODO: GTK 1.x does not support EchoMode emNone.
// This will have to be coded around, but not a priority
SetPasswordChar(ACustomEdit, ACustomEdit.PasswordChar);
end;
procedure TGtkWSCustomEdit.SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer);
procedure TGtkWSCustomEdit.SetMaxLength(const ACustomEdit: TCustomEdit;
NewLength: integer);
var
Widget: PGtkWidget;
begin
gtk_entry_set_max_length(GTK_ENTRY(ACustomEdit.Handle), guint16(NewLength));
Widget:=PGtkWidget(ACustomEdit.Handle);
if GtkWidgetIsA(Widget,GTK_ENTRY_TYPE) then
gtk_entry_set_max_length(GTK_ENTRY(Widget), guint16(NewLength));
end;
procedure TGtkWSCustomEdit.SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char);
procedure TGtkWSCustomEdit.SetPasswordChar(const ACustomEdit: TCustomEdit;
NewChar: char);
var
Widget: PGtkWidget;
begin
gtk_entry_set_visibility(GTK_ENTRY(ACustomEdit.Handle),
(ACustomEdit.EchoMode = emNormal) and (NewChar = #0));
Widget:=PGtkWidget(ACustomEdit.Handle);
if GtkWidgetIsA(Widget,GTK_ENTRY_TYPE) then
gtk_entry_set_visibility(GTK_ENTRY(Widget),
(ACustomEdit.EchoMode = emNormal) and (NewChar = #0));
end;
procedure TGtkWSCustomEdit.SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean);
procedure TGtkWSCustomEdit.SetReadOnly(const ACustomEdit: TCustomEdit;
NewReadOnly: boolean);
var
Widget: PGtkWidget;
begin
gtk_entry_set_editable(GTK_ENTRY(ACustomEdit.Handle), not ACustomEdit.ReadOnly);
Widget:=PGtkWidget(ACustomEdit.Handle);
if GtkWidgetIsA(Widget,GTK_ENTRY_TYPE) then
gtk_entry_set_editable(GTK_ENTRY(Widget), not ACustomEdit.ReadOnly);
end;
procedure TGtkWSCustomEdit.SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer);
procedure TGtkWSCustomEdit.SetSelStart(const ACustomEdit: TCustomEdit;
NewStart: integer);
begin
gtk_editable_set_position(PGtkOldEditable(GetWidgetInfo(
Pointer(ACustomEdit.Handle), true)^.CoreWidget), NewStart);
end;
procedure TGtkWSCustomEdit.SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer);
procedure TGtkWSCustomEdit.SetSelLength(const ACustomEdit: TCustomEdit;
NewLength: integer);
begin
WidgetSetSelLength(GetWidgetInfo(Pointer(ACustomEdit.Handle), true)^.CoreWidget, NewLength);
WidgetSetSelLength(GetWidgetInfo(Pointer(ACustomEdit.Handle),true)^.CoreWidget,
NewLength);
end;
{ TGtkWSCustomLabel }
@ -711,23 +733,27 @@ end;
{ TGtkWSCustomCheckBox }
function TGtkWSCustomCheckBox.RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState;
function TGtkWSCustomCheckBox.RetrieveState(
const ACustomCheckBox: TCustomCheckBox): TCheckBoxState;
begin
if gtk_toggle_button_get_active (PGtkToggleButton(ACustomCheckBox.Handle))
then Result := cbChecked
else Result := cbUnChecked;
end;
procedure TGtkWSCustomCheckBox.SetShortCut(const ACustomCheckBox: TCustomCheckBox;
procedure TGtkWSCustomCheckBox.SetShortCut(
const ACustomCheckBox: TCustomCheckBox;
const OldShortCut, NewShortCut: TShortCut);
begin
// ToDo: use accelerator group of Form
Accelerate(ACustomCheckBox, PGtkWidget(ACustomCheckBox.Handle), NewShortcut, 'activate_item');
Accelerate(ACustomCheckBox, PGtkWidget(ACustomCheckBox.Handle), NewShortcut,
'activate_item');
end;
{ TGtkWSCustomMemo }
procedure TGtkWSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; AText: string);
procedure TGtkWSCustomMemo.AppendText(const ACustomMemo: TCustomMemo;
const AText: string);
var
Widget: PGtkWidget;
CurMemoLen: cardinal;
@ -852,14 +878,11 @@ initialization
// RegisterWSComponent(TListBox, TGtkWSListBox);
RegisterWSComponent(TCustomEdit, TGtkWSCustomEdit);
RegisterWSComponent(TCustomMemo, TGtkWSCustomMemo);
// RegisterWSComponent(TEdit, TGtkWSEdit);
// RegisterWSComponent(TMemo, TGtkWSMemo);
// RegisterWSComponent(TCustomLabel, TGtkWSCustomLabel);
RegisterWSComponent(TCustomLabel, TGtkWSCustomLabel);
// RegisterWSComponent(TLabel, TGtkWSLabel);
// RegisterWSComponent(TButtonControl, TGtkWSButtonControl);
RegisterWSComponent(TCustomCheckBox, TGtkWSCustomCheckBox);
// RegisterWSComponent(TCheckBox, TGtkWSCheckBox);
// RegisterWSComponent(TCheckBox, TGtkWSCheckBox);
// RegisterWSComponent(TToggleBox, TGtkWSToggleBox);
// RegisterWSComponent(TRadioButton, TGtkWSRadioButton);
// RegisterWSComponent(TCustomStaticText, TGtkWSCustomStaticText);

View File

@ -146,7 +146,7 @@ type
private
protected
public
class procedure AppendText(const ACustomMemo: TCustomMemo; AText: string); override;
class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); override;
class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
end;
@ -542,7 +542,7 @@ end;
{ TWin32WSCustomMemo }
procedure TWin32WSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; AText: string);
procedure TWin32WSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; const AText: string);
var
S: string;
begin

View File

@ -566,21 +566,21 @@ type
procedure CopyToClipboard; virtual;
procedure CutToClipboard; virtual;
procedure PasteFromClipboard; virtual;
public
property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
property EchoMode: TEchoMode read FEchoMode write SetEchoMode default emNormal;
property MaxLength: Integer read FMaxLength write SetMaxLength default -1;
property Modified: Boolean read GetModified write SetModified;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
property PopupMenu;
property ReadOnly: Boolean read FReadOnly write SetReadOnly default false;
property SelLength: integer read GetSelLength write SetSelLength;
property SelStart: integer read GetSelStart write SetSelStart;
property SelText: String read GetSelText write SetSelText;
property Modified: Boolean read GetModified write SetModified;
property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
property Text;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
property PopupMenu;
property TabStop default true;
property TabOrder;
property TabStop default true;
property Text;
end;
@ -703,6 +703,7 @@ type
property PopupMenu;
property ReadOnly;
property ScrollBars;
property TabOrder;
property TabStop;
property Visible;
property WordWrap;
@ -1174,6 +1175,9 @@ end.
{ =============================================================================
$Log$
Revision 1.169 2004/09/22 19:05:58 mattias
various fixes for TCustomMemo, RTTIControls, FindReferences
Revision 1.168 2004/09/22 14:50:18 micha
convert LM_SETPROPERTIES message for tcustomlabel to interface methods

View File

@ -131,7 +131,7 @@ type
{ TWSCustomMemo }
TWSCustomMemo = class(TWSCustomEdit)
class procedure AppendText(const ACustomMemo: TCustomMemo; AText: string); virtual;
class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); virtual;
class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); virtual;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); virtual;
end;
@ -349,7 +349,7 @@ end;
{ TWSCustomMemo }
procedure TWSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; AText: string);
procedure TWSCustomMemo.AppendText(const ACustomMemo: TCustomMemo; const AText: string);
begin
end;

View File

@ -46,9 +46,9 @@ uses
MemCheck,
{$ENDIF}
Classes, SysUtils, AVL_Tree, Laz_XMLCfg, FileCtrl, LCLProc, Forms, Controls,
Dialogs, LazarusIDEStrConsts, IDEProcs, LazConf, CompilerOptions, PackageLinks,
PackageDefs, LazarusPackageIntf, ComponentReg, RegisterFCL, RegisterLCL,
RegisterSynEdit, RegisterIDEIntf;
Dialogs, LazarusIDEStrConsts, IDEProcs, LazConf, CompilerOptions,
PackageLinks, PackageDefs, LazarusPackageIntf, ComponentReg, RegisterFCL,
RegisterLCL, RegisterSynEdit, RegisterIDEIntf;
type
TFindPackageFlag = (
@ -188,6 +188,7 @@ type
procedure IteratePackagesSorted(Flags: TFindPackageFlags;
Event: TIteratePackagesEvent);
procedure MarkAllPackagesAsNotVisited;
procedure MarkAllRequiredPackages(FirstDependency: TPkgDependency);
procedure MarkNeededPackages;
procedure ConsistencyCheck;
public
@ -1750,6 +1751,25 @@ begin
end;
end;
procedure TLazPackageGraph.MarkAllRequiredPackages(
FirstDependency: TPkgDependency);
var
Dependency: TPkgDependency;
RequiredPackage: TLazPackage;
begin
Dependency:=FirstDependency;
while Dependency<>nil do begin
if Dependency.LoadPackageResult=lprSuccess then begin
RequiredPackage:=Dependency.RequiredPackage;
if not (lpfVisited in RequiredPackage.Flags) then begin
RequiredPackage.Flags:=RequiredPackage.Flags+[lpfVisited];
MarkAllRequiredPackages(RequiredPackage.FirstRequiredDependency);
end;
end;
Dependency:=Dependency.NextRequiresDependency;
end;
end;
procedure TLazPackageGraph.CloseUnneededPackages;
var
i: Integer;

View File

@ -184,6 +184,7 @@ type
ComponentClassnames: TStrings;
var List: TObjectArray): TModalResult;
function GetOwnersOfUnit(const UnitFilename: string): TList; override;
procedure ExtendOwnerListWithUsedByOwners(OwnerList: TList); override;
function GetSourceFilesOfOwners(OwnerList: TList): TStrings; override;
function DoOpenPkgFile(PkgFile: TPkgFile): TModalResult;
function FindVirtualUnitSource(PkgFile: TPkgFile): string;
@ -2814,6 +2815,50 @@ begin
FreeThenNil(Result);
end;
procedure TPkgManager.ExtendOwnerListWithUsedByOwners(OwnerList: TList);
// use items (packages and projects) in OwnerList as leaves and create the
// list of all packages and projects using them.
// The result will be the topologically sorted list of projects and packages
// using the projects/packages in OwnerList, beginning with the top levels.
var
AddedNonPackages: TList;
procedure AddUsedByOwners(ADependenyOwner: TObject);
var
LazPackage: TLazPackage;
Dependency: TPkgDependency;
begin
if ADependenyOwner is TProject then begin
if AddedNonPackages.IndexOf(ADependenyOwner)>=0 then exit;
AddedNonPackages.Add(ADependenyOwner);
OwnerList.Add(ADependenyOwner);
end else if ADependenyOwner is TLazPackage then begin
LazPackage:=TLazPackage(ADependenyOwner);
if lpfVisited in LazPackage.Flags then exit;
LazPackage.Flags:=LazPackage.Flags+[lpfVisited];
Dependency:=LazPackage.FirstUsedByDependency;
while Dependency<>nil do begin
AddUsedByOwners(Dependency.Owner);
Dependency:=Dependency.NextUsedByDependency;
end;
OwnerList.Add(LazPackage);
end;
end;
var
i: Integer;
OldOwnerList: TList;
begin
OldOwnerList:=TList.Create;
OldOwnerList.Assign(OwnerList);
OwnerList.Clear;
AddedNonPackages:=TList.Create;
PackageGraph.MarkAllPackagesAsNotVisited;
for i:=0 to OldOwnerList.Count-1 do
AddUsedByOwners(TObject(OldOwnerList[i]));
OldOwnerList.Free;
end;
function TPkgManager.GetSourceFilesOfOwners(OwnerList: TList): TStrings;
procedure AddFile(TheOwner: TObject; const Filename: string);