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

(cherry picked from commit 0c056fc0d2)

designer/jitforms.pp

@@ -50,7 +50,7 @@ uses
   // LCL
   Forms, Controls, Dialogs, LResources, LCLMemManager, LCLProc,
   //LazUtils
-  AvgLvlTree, LazUtilities, LazLoggerBase, LazTracer,
+  AvgLvlTree, LazUtilities, LazStringUtils, LazLoggerBase, LazTracer,
   // CodeTools
   BasicCodeTools,
   // IdeIntf
@@ -71,8 +71,7 @@ type
   TJITFormErrors = set of TJITFormError;
   
   TJITReaderErrorEvent = procedure(Sender: TObject; Reader: TReader;
-                                   ErrorType: TJITFormError;
+                                   ErrorType: TJITFormError) of object;
-                                   var Action: TModalResult) of object;
   TJITBeforeCreateEvent = procedure(Sender: TObject; Instance: TPersistent) of object;
   TJITExceptionEvent = procedure(Sender: TObject; E: Exception;
                                  var Action: TModalResult) of object;
@@ -86,6 +85,7 @@ type
   TJITFindClass = procedure(Sender: TObject;
                             const VarName, aClassUnitName, aClassName: string;
                             var ComponentClass: TComponentClass) of object;
+  EUnknownProperty = class(Exception);
 
 
   { TJITComponentList }
@@ -972,6 +972,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);
@@ -1922,36 +1924,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
+  if LazStartsStr(SUnknownProperty, ErrorMsg) then
-    ErrorType:=jfeUnknownProperty;
+    ErrorType:=jfeUnknownProperty
-    Action:=mrIgnore;
+  else
-  end;
+    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);
+    OnReaderError(Self,Reader,ErrorType);
-  Handled:=Action in [mrIgnore];
+  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;

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,
+  try
-              AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,
+    NewJITIndex := JITList.AddJITComponentFromStream(BinStream, UnitResourcefileFormat,
-              ContextObj);
+                AncestorType,NewUnitName,Interactive,Visible,DisableAutoSize,
-  if NewJITIndex < 0 then begin
+                ContextObj);
-    Result:=nil;
+    if NewJITIndex < 0 then
-    exit;
+      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

ide/lazarusidestrconsts.pas

@@ -6006,9 +6006,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';

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;
@@ -6081,7 +6082,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,'"');
@@ -6278,9 +6279,12 @@ begin
             DebugLn(['LoadLFM DoFixupComponentReferences failed']);
             exit;
           end;
-        end else begin
+        end
-          // error streaming component -> examine lfm file
+        else begin
-          DebugLn('ERROR: streaming failed lfm="',LFMBuf.Filename,'"');
+          // 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,
@@ -6302,7 +6306,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,'"']);