IDE: designer: improved error messages

git-svn-id: trunk@15228 -

designer/jitforms.pp

@@ -43,7 +43,8 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, SysUtils, AvgLvlTree, TypInfo, LCLProc, LResources, Forms, Controls,
-  LCLMemManager, LCLIntf, Dialogs, JITForm, IDEProcs,
+  LCLMemManager, LCLIntf, Dialogs,
+  PropEdits, JITForm, IDEProcs,
   BasePkgManager;
 
 type
@@ -57,7 +58,8 @@ type
     );
   TJITFormErrors = set of TJITFormError;
   
-  TJITReaderErrorEvent = procedure(Sender: TObject; ErrorType: TJITFormError;
+  TJITReaderErrorEvent = procedure(Sender: TObject; Reader: TReader;
+                                   ErrorType: TJITFormError;
                                    var Action: TModalResult) of object;
   TJITPropertyNotFoundEvent = procedure(Sender: TObject; Reader: TReader;
                    Instance: TPersistent; var PropName: string; IsPath: boolean;
@@ -87,10 +89,11 @@ type
     FOnPropertyNotFound: TJITPropertyNotFoundEvent;
   protected
     FCurReadErrorMsg: string;
-    FCurReadJITComponent:TComponent;
+    FCurReadJITComponent: TComponent;
-    FCurReadClass:TClass;
+    FCurReadClass: TClass;
     FCurReadChild: TComponent;
     FCurReadChildClass: TComponentClass;
+    FCurReadStreamClass: TClass;
     FOnReaderError: TJITReaderErrorEvent;
     FJITComponents: TList;
     FFlags: TJITCompListFlags;
@@ -180,6 +183,7 @@ type
     property OnFindClass: TJITFindClass read FOnFindClass write FOnFindClass;
     property CurReadJITComponent: TComponent read FCurReadJITComponent;
     property CurReadClass: TClass read FCurReadClass;
+    property CurReadStreamClass: TClass read FCurReadStreamClass;
     property CurReadChild: TComponent read FCurReadChild;
     property CurReadChildClass: TComponentClass read FCurReadChildClass;
     property CurReadErrorMsg: string read FCurReadErrorMsg;
@@ -620,8 +624,8 @@ end;
 destructor TJITComponentList.Destroy;
 begin
   while FJITComponents.Count>0 do DestroyJITComponent(FJITComponents.Count-1);
-  FJITComponents.Free;
+  FreeAndNil(FJITComponents);
-  FErrors.Free;
+  FreeAndNil(FErrors);
   inherited Destroy;
 end;
 
@@ -743,7 +747,7 @@ function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
 //  returns new index
 // -1 = invalid stream
 
-  procedure ReadStream(AStream: TStream);
+  procedure ReadStream(AStream: TStream; StreamClass: TClass);
   var
     Reader:TReader;
     DestroyDriver: Boolean;
@@ -752,6 +756,7 @@ function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
     debugln('[TJITComponentList.AddJITComponentFromStream] InitReading ...');
     {$ENDIF}
 
+    FCurReadStreamClass:=StreamClass;
     DestroyDriver:=false;
     InitReading(AStream,Reader,DestroyDriver);
     {$IFDEF VerboseJITForms}
@@ -796,7 +801,7 @@ function TJITComponentList.AddJITComponentFromStream(BinStream: TStream;
         DebugLn(['TJITComponentList.AddJITComponentFromStream.ReadAncestor ',DbgSName(AClass),' HasStream=',AncestorStream<>nil]);
         {$ENDIF}
         if AncestorStream<>nil then
-          ReadStream(AncestorStream);
+          ReadStream(AncestorStream,AClass);
       finally
         FreeAndNil(AncestorStream);
       end;
@@ -828,7 +833,7 @@ begin
     Result:=DoCreateJITComponent('',NewClassName,NewUnitName,ParentClass,Visible);
     if Result<0 then exit;
     ReadAncestorStreams;
-    ReadStream(BinStream);
+    ReadStream(BinStream,FCurReadJITComponent.ClassType);
 
     if FCurReadJITComponent.Name='' then begin
       NewName:=FCurReadJITComponent.ClassName;
@@ -870,6 +875,7 @@ procedure TJITComponentList.InitReading(BinStream: TStream;
   var Reader: TReader; DestroyDriver: Boolean);
 begin
   FFlags:=FFlags-[jclAutoRenameComponents];
+  FErrors.Clear;
   
   MyFindGlobalComponentProc:=@OnFindGlobalComponent;
   RegisterFindGlobalComponentProc(@MyFindGlobalComponent);
@@ -916,6 +922,7 @@ begin
   Result:=-1;
   Instance:=nil;
   FCurReadClass:=nil;
+  FCurReadStreamClass:=nil;
   FCurReadJITComponent:=nil;
   
   try
@@ -954,6 +961,7 @@ begin
       try
         if FCurReadClass<>nil then
           FreeJITClass(FCurReadClass);
+        FCurReadStreamClass:=nil;
         Instance.Free;
       except
         on E: Exception do begin
@@ -1078,6 +1086,7 @@ begin
     try
       FCurReadJITComponent:=JITOwnerComponent;
       FCurReadClass:=JITOwnerComponent.ClassType;
+      FCurReadStreamClass:=FCurReadClass;
 
       FFlags:=FFlags+[jclAutoRenameComponents];
       {$IFDEF VerboseJITForms}
@@ -1556,7 +1565,7 @@ begin
     FErrors.Add(-1,ErrorBinPos,nil);
   end;
   if Assigned(OnReaderError) then
-    OnReaderError(Self,ErrorType,Action);
+    OnReaderError(Self,Reader,ErrorType,Action);
   Handled:=Action in [mrIgnore];
   FCurUnknownProperty:='';
   
@@ -1586,7 +1595,7 @@ end;
 
 procedure TJITComponentList.ReaderCreateComponent(Reader: TReader;
   ComponentClass: TComponentClass; var Component: TComponent);
-{$IFDEF EnableTFrame2}
+{$IFDEF EnableTFrame}
 var
   DestroyDriver: Boolean;
   SubReader: TReader;
@@ -1598,7 +1607,7 @@ begin
   fCurReadChild:=Component;
   fCurReadChildClass:=ComponentClass;
   
-  {$IFDEF EnableTFrame2}
+  {$IFDEF EnableTFrame}
   if Assigned(OnFindAncestorBinStream) then begin
     BinStream:=nil;
     DestroyDriver:=false;

ide/customformeditor.pp

@@ -133,8 +133,8 @@ each control that's dropped onto the form
     procedure SetSelection(const ASelection: TPersistentSelectionList);
     procedure OnObjectInspectorModified(Sender: TObject);
     procedure SetObj_Inspector(AnObjectInspector: TObjectInspectorDlg); virtual;
-    procedure JITListReaderError(Sender: TObject; ErrorType: TJITFormError;
+    procedure JITListReaderError(Sender: TObject; Reader: TReader;
-          var Action: TModalResult); virtual;
+          ErrorType: TJITFormError; var Action: TModalResult); virtual;
     procedure JITListPropertyNotFound(Sender: TObject; Reader: TReader;
       Instance: TPersistent; var PropName: string; IsPath: boolean;
       var Handled, Skip: Boolean);
@@ -2005,27 +2005,48 @@ begin
 end;
 
 procedure TCustomFormEditor.JITListReaderError(Sender: TObject;
-  ErrorType: TJITFormError; var Action: TModalResult);
+  Reader: TReader; ErrorType: TJITFormError; var Action: TModalResult);
 var
   aCaption, aMsg: string;
   DlgType: TMsgDlgType;
   Buttons: TMsgDlgButtons;
   HelpCtx: Longint;
   JITComponentList: TJITComponentList;
+  StreamClass: TComponentClass;
+  AnUnitInfo: TUnitInfo;
+  LFMFilename: String;
+  ErrorBinPos: Int64;
 begin
   JITComponentList:=TJITComponentList(Sender);
-  aCaption:='Error reading '+JITComponentList.ClassName;
+  aCaption:='Read error';
   aMsg:='';
   DlgType:=mtError;
   Buttons:=[mbCancel];
   HelpCtx:=0;
   
+  // 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:='Error reading '+ExtractFilename(LFMFilename);
+  
   with JITComponentList do begin
-    aMsg:=aMsg+ClassName+': ';
+    if LFMFilename<>'' then
-    if CurReadJITComponent<>nil then
+      aMsg:=aMsg+LFMFilename
-      aMsg:=aMsg+CurReadJITComponent.Name+':'+CurReadJITComponent.ClassName
+    else if CurReadStreamClass<>nil then
+      aMsg:=aMsg+'Stream='+CurReadStreamClass.ClassName
     else
-      aMsg:=aMsg+'?';
+      aMsg:=aMsg+'JITList='+ClassName;
+    aMsg:=aMsg+': ';
+    if CurReadJITComponent<>nil then
+      aMsg:=aMsg+'Root='+CurReadJITComponent.Name+':'+CurReadJITComponent.ClassName;
     if CurReadChild<>nil then
       aMsg:=aMsg+#13'Component: '
         +CurReadChild.Name+':'+CurReadChild.ClassName
@@ -2033,6 +2054,10 @@ begin
       aMsg:=aMsg+#13'Component Class: '+CurReadChildClass.ClassName;
     aMsg:=aMsg+#13+CurReadErrorMsg;
   end;
+  if (Reader<>nil) and (Reader.Driver is TLRSObjectReader) then begin
+    ErrorBinPos:=TLRSObjectReader(Reader.Driver).Stream.Position;
+    aMsg:=aMsg+#13+'Stream position: '+dbgs(ErrorBinPos);
+  end;
 
   case ErrorType of
     jfeUnknownProperty, jfeReaderError:

ide/project.pp

@@ -713,6 +713,7 @@ type
     function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
     function UnitWithEditorIndex(Index:integer): TUnitInfo;
     function UnitWithComponent(AComponent: TComponent): TUnitInfo;
+    function UnitWithComponentClass(AClass: TComponentClass): TUnitInfo;
     function UnitWithComponentName(AComponentName: String): TUnitInfo;
     function UnitComponentInheritingFrom(AClass: TComponentClass;
                                          Ignore: TUnitInfo): TUnitInfo;
@@ -4150,6 +4151,13 @@ begin
     Result:=Result.fNext[uilWithComponent];
 end;
 
+function TProject.UnitWithComponentClass(AClass: TComponentClass): TUnitInfo;
+begin
+  Result:=fFirst[uilWithComponent];
+  while (Result<>nil) and (Result.Component.ClassType<>AClass) do
+    Result:=Result.fNext[uilWithComponent];
+end;
+
 function TProject.UnitWithComponentName(AComponentName: String): TUnitInfo;
 begin
   Result := fFirst[uilPartOfProject];

lcl/lresources.pp

@@ -238,6 +238,7 @@ type
   public
     constructor Create;
     destructor Destroy; override;
+    procedure Clear;
     procedure Sort(LFMPositions: Boolean);
     function IndexOf(const Position: int64; LFMPositions: Boolean): integer;
     function IndexOfRange(const FromPos, ToPos: int64;
@@ -4309,6 +4310,11 @@ begin
   inherited Destroy;
 end;
 
+procedure TLRPositionLinks.Clear;
+begin
+  Count:=0;
+end;
+
 procedure TLRPositionLinks.Sort(LFMPositions: Boolean);
 begin
   if LFMPositions then