diff --git a/designer/jitforms.pp b/designer/jitforms.pp index 1c8fc7eaef..9121c8336a 100644 --- a/designer/jitforms.pp +++ b/designer/jitforms.pp @@ -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; diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index b175b4b0ac..808ad50ceb 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -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 diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 34580f6987..fc9da744b8 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -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'; diff --git a/ide/sourcefilemanager.pas b/ide/sourcefilemanager.pas index 07230350c0..55b329d5e9 100644 --- a/ide/sourcefilemanager.pas +++ b/ide/sourcefilemanager.pas @@ -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,'"']);