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

IDE: Remove unknown component properties using the same GUI already used in other situations. Issue #40377.

Browse Source
This commit is contained in:
Juha 2023-07-15 18:08:28 +03:00
parent ebd0bf4135
commit 0c056fc0d2
4 changed files with 34 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
designer/jitforms.pp
View File

@ -46,7 +46,7 @@ uses
// LCL
Forms, Controls, Dialogs, LResources, LCLMemManager, LCLProc,
//LazUtils
AvgLvlTree, LazUtilities, LazLoggerBase, LazTracer,
AvgLvlTree, LazUtilities, LazStringUtils, LazLoggerBase, LazTracer,
// CodeTools
BasicCodeTools,
// IdeIntf
@ -67,8 +67,7 @@ type
TJITFormErrors = set of TJITFormError;
TJITReaderErrorEvent = procedure(Sender: TObject; Reader: TReader;
ErrorType: TJITFormError;
var Action: TModalResult) of object;
ErrorType: TJITFormError) of object;
TJITBeforeCreateEvent = procedure(Sender: TObject; Instance: TPersistent) of object;
TJITExceptionEvent = procedure(Sender: TObject; E: Exception;
var Action: TModalResult) of object;
@ -82,6 +81,7 @@ type
TJITFindClass = procedure(Sender: TObject;
const VarName, aClassUnitName, aClassName: string;
var ComponentClass: TComponentClass) of object;
EUnknownProperty = class(Exception);
{ TJITComponentList }
@ -968,6 +968,8 @@ begin
AControl.ControlStyle:=AControl.ControlStyle+[csSetCaption];
end;
except
on E: EUnknownProperty do
raise; // Will be caught in TCustomFormEditor.CreateRawComponentFromStream
on E: Exception do begin
HandleException(E,'[TJITComponentList.AddJITComponentFromStream] ERROR reading form stream'
+' of Class "'+NewClassName+'"',Action);
@ -1904,36 +1906,34 @@ end;
procedure TJITComponentList.ReaderError(Reader: TReader;
const ErrorMsg: Ansistring; var Handled: Boolean);
// ToDo: use SUnknownProperty when it is published by the fpc team
const
// rtlconst.inc has SUnknownProperty = 'Unknown property: "%s"';
SUnknownProperty = 'Unknown property';
var
ErrorType: TJITFormError;
Action: TModalResult;
ErrorBinPos: Int64;
begin
ErrorType:=jfeReaderError;
Action:=mrCancel;
FCurReadErrorMsg:=ErrorMsg;
FCurUnknownProperty:=''; // ToDo find name property
// find out, what error occurred
if RightStr(ErrorMsg,length(SUnknownProperty))=SUnknownProperty then begin
ErrorType:=jfeUnknownProperty;
Action:=mrIgnore;
end;
if LazStartsStr(SUnknownProperty, ErrorMsg) then
ErrorType:=jfeUnknownProperty
else
ErrorType:=jfeReaderError;
if Reader.Driver is TLRSObjectReader then begin
// save error position
ErrorBinPos:=TLRSObjectReader(Reader.Driver).Stream.Position;
FErrors.Add(-1,ErrorBinPos,nil);
end;
if Assigned(OnReaderError) then
OnReaderError(Self,Reader,ErrorType,Action);
Handled:=Action in [mrIgnore];
OnReaderError(Self,Reader,ErrorType);
Handled:=true;
FCurUnknownProperty:='';
DebugLn('>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
DebugLn(['[TJITComponentList.ReaderError] "'+ErrorMsg+'" ignoring=',Handled]);
DebugLn('<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<');
// EUnknownProperty will be caught in TCustomFormEditor.CreateRawComponentFromStream
raise EUnknownProperty.Create('');
end;
procedure TJITComponentList.ReaderFindComponentClass(Reader: TReader;

100
ide/customformeditor.pp
View File

@ -98,8 +98,6 @@ type
procedure SetSelection(const ASelection: TPersistentSelectionList);
procedure OnObjectInspectorModified(Sender: TObject);
procedure SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg); virtual;
procedure JITListReaderError(Sender: TObject; Reader: TReader;
ErrorType: TJITFormError; var Action: TModalResult); virtual;
procedure JITListBeforeCreate(Sender: TObject; Instance: TPersistent);
procedure JITListException(Sender: TObject; E: Exception;
var {%H-}Action: TModalResult);
@ -338,9 +336,7 @@ var
implementation
function CompareDefPropCacheItems(Item1, Item2: TDefinePropertiesCacheItem
): integer;
function CompareDefPropCacheItems(Item1, Item2: TDefinePropertiesCacheItem): integer;
begin
Result:=CompareText(Item1.PersistentClassname,Item2.PersistentClassname);
end;
@ -487,7 +483,6 @@ constructor TCustomFormEditor.Create;
procedure InitJITList(List: TJITComponentList);
begin
List.OnReaderError:=@JITListReaderError;
List.OnBeforeCreate:=@JITListBeforeCreate;
List.OnException:=@JITListException;
List.OnPropertyNotFound:=@JITListPropertyNotFound;
@ -1618,12 +1613,15 @@ begin
if JITList=nil then
RaiseGDBException('TCustomFormEditor.CreateComponentFromStream ClassName='+
AncestorType.ClassName);
NewJITIndex := JITList.AddJITComponentFromStream(BinStream, UnitResourcefileFormat,
AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,
ContextObj);
if NewJITIndex < 0 then begin
Result:=nil;
exit;
try
NewJITIndex := JITList.AddJITComponentFromStream(BinStream, UnitResourcefileFormat,
AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,
ContextObj);
if NewJITIndex < 0 then
exit(nil);
except
on E: EUnknownProperty do
exit(nil);
end;
Result:=JITList[NewJITIndex];
end;
@ -2126,84 +2124,6 @@ begin
RegisterDefineProperty('TStrings','Strings');
end;
procedure TCustomFormEditor.JITListReaderError(Sender: TObject;
Reader: TReader; ErrorType: TJITFormError; var Action: TModalResult);
var
aCaption, aMsg: string;
DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons;
JITComponentList: TJITComponentList;
StreamClass: TComponentClass;
AnUnitInfo: TUnitInfo;
LFMFilename: String;
ErrorBinPos: Int64;
begin
JITComponentList:=TJITComponentList(Sender);
aCaption:='Read error';
aMsg:='';
DlgType:=mtError;
Buttons:=[mbCancel];
// get current lfm filename
LFMFilename:='';
if (JITComponentList.CurReadStreamClass<>nil)
and (JITComponentList.CurReadStreamClass.InheritsFrom(TComponent)) then begin
StreamClass:=TComponentClass(JITComponentList.CurReadStreamClass);
AnUnitInfo:=Project1.UnitWithComponentClass(StreamClass);
if AnUnitInfo<>nil then begin
LFMFilename:=ChangeFileExt(AnUnitInfo.Filename,'.lfm');
end;
end;
if LFMFilename<>'' then
aCaption:=Format(lisCFEErrorReading, [ExtractFilename(LFMFilename)]);
with JITComponentList do begin
if LFMFilename<>'' then
aMsg:=aMsg+LFMFilename
else if CurReadStreamClass<>nil then
aMsg:=Format(lisCFEStream, [aMsg, CurReadStreamClass.ClassName])
else
aMsg:=aMsg+'JITList='+ClassName;
aMsg:=aMsg+': ';
if CurReadJITComponent<>nil then
aMsg:=Format(lisCFERoot, [aMsg, CurReadJITComponent.Name,
CurReadJITComponent.ClassName]);
if CurReadChild<>nil then
aMsg:=Format(lisCFEComponent,
[aMsg, LineEnding, CurReadChild.Name, CurReadChild.ClassName])
else if CurReadChildClass<>nil then
aMsg:=Format(lisCFEComponentClass,
[aMsg, LineEnding, CurReadChildClass.ClassName]);
aMsg:=aMsg+LineEnding+CurReadErrorMsg;
end;
if (Reader<>nil) and (Reader.Driver is TLRSObjectReader) then begin
ErrorBinPos:=TLRSObjectReader(Reader.Driver).Stream.Position;
aMsg:=Format(lisCFEStreamPosition, [aMsg, LineEnding, dbgs(ErrorBinPos)]);
end;
case ErrorType of
jfeUnknownProperty, jfeReaderError:
begin
Buttons:=[mbIgnore,mbCancel];
end;
jfeUnknownComponentClass:
begin
aMsg:=Format(lisCFEClassNotFound,
[aMsg, LineEnding, JITComponentList.CurUnknownClassName]);
end;
end;
if Buttons=[mbIgnore,mbCancel] then begin
Action:=IDEQuestionDialog(aCaption,aMsg,DlgType,
[mrIgnore, lisCFEContinueLoading,
mrCancel, lisCFECancelLoadingThisResource,
mrAbort, lisCFEStopAllLoading]);
end else begin
Action:=IDEQuestionDialog(aCaption,aMsg,DlgType,
[mrCancel, lisCFECancelLoadingThisResource,
mrAbort, lisCFEStopAllLoading]);
end;
end;
procedure TCustomFormEditor.JITListBeforeCreate(Sender: TObject;
Instance: TPersistent);
var

3
ide/lazarusidestrconsts.pas
View File

@ -6010,9 +6010,6 @@ resourcestring
lisCFEErrorDestroyingComponentOfTypeOfUnit = 'Error destroying component of '
+'type %s of unit %s:%s%s';
lisCFEErrorDestroyingComponent = 'Error destroying component';
lisCFEContinueLoading = 'Continue loading';
lisCFECancelLoadingThisResource = 'Cancel loading this resource';
lisCFEStopAllLoading = 'Stop all loading';
lisCFEErrorReading = 'Error reading %s';
lisCFEComponent = '%s%sComponent: %s:%s';
lisCFEComponentClass = '%s%sComponent Class: %s';

16
ide/sourcefilemanager.pas
View File

@ -1185,7 +1185,8 @@ var
begin
{$IFDEF IDE_VERBOSE}
DebugLn('');
DebugLn(['*** TFileOpener.OpenEditorFile START "',AFilename,'" ',OpenFlagsToString(Flags),' Window=',WindowIndex,' Page=',PageIndex]);
DebugLn(['*** TFileOpener.OpenEditorFile START "',FFilename,'" ',OpenFlagsToString(AFlags),
' Page=',APageIndex,' Window=',AWindowIndex]);
{$ENDIF}
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TFileOpener.OpenEditorFile START');{$ENDIF}
FPageIndex := APageIndex;
@ -6079,7 +6080,7 @@ begin
NewClassName,LCLVersion,MissingClasses,AmbiguousClasses);
i:=Pos('/',NewClassName);
if i>0 then
System.Delete(NewClassName,1,i); // cut unitname
Delete(NewClassName,1,i); // cut unitname
{$IFDEF VerboseLFMSearch}
debugln('LoadLFM LFM="',LFMBuf.Source,'"');
@ -6274,9 +6275,12 @@ begin
DebugLn(['LoadLFM DoFixupComponentReferences failed']);
exit;
end;
end else begin
// error streaming component -> examine lfm file
DebugLn('ERROR: streaming failed lfm="',LFMBuf.Filename,'"');
end
else begin
// Error streaming component -> examine lfm file,
// but not when opening project. It would open many lfm file copies.
if ofProjectLoading in OpenFlags then exit;
DebugLn('LoadLFM ERROR: streaming failed lfm="',LFMBuf.Filename,'"');
// open lfm file in editor
if AnUnitInfo.OpenEditorInfoCount > 0 then
Result:=OpenEditorFile(LFMBuf.Filename,
@ -6298,7 +6302,7 @@ begin
finally
BinStream.Free;
end;
end else if SysUtils.CompareText(AnUnitInfo.Component.ClassName,NewClassName)<>0
end else if CompareText(AnUnitInfo.Component.ClassName,NewClassName)<>0
then begin
// lfm and current designer are about different classes
debugln(['LoadLFM unit="',AnUnitInfo.Filename,'": loaded component has class "',AnUnitInfo.Component.ClassName,'", lfm has class "',NewClassName,'"']);