Re: [lazarus] TApplication.HandleException

[Colin Western]

Mattias Gaertner wrote:

On Sun, 07 May 2006 11:18:33 +0100
Colin Western <[EMAIL PROTECTED]> wrote:

Can I suggest the following patch, which makes it easier to customize the Exception handling behavior (I only sometimes want a back trace)

The backtrace must be written before, otherwise a heap error can create a
bug in the error handling itself and the user will not get a valid
backtrace.

We could add "if not (AppNoExceptionMessages in FFlags) then" in front of the DumpExceptionBackTrace;

Good point. How about the attached?
Colin

diff -uNr lazarus/lcl/forms.pp /dos/fpc/lazarus.w/lcl/forms.pp
--- lazarus/lcl/forms.pp	2006-05-07 10:53:53.000000000 +0100
+++ /dos/fpc/lazarus.w/lcl/forms.pp	2006-05-08 21:18:34.000000000 +0100
@@ -927,6 +927,7 @@
     procedure IconChanged(Sender: TObject);
     function InvokeHelp(Command: Word; Data: Longint): Boolean;
     function GetControlAtMouse: TControl;
+    procedure SetFlags(const AValue: TApplicationFlags);
     procedure SetNavigation(const AValue: TApplicationNavigationOptions);
     procedure UpdateMouseControl(NewMouseControl: TControl);
     procedure MouseIdle(const CurrentControl: TControl);
@@ -1035,6 +1036,7 @@
                                         write SetCaptureExceptions;
     property FindGlobalComponentEnabled: boolean read FFindGlobalComponentEnabled
                                                write FFindGlobalComponentEnabled;
+    property Flags: TApplicationFlags read FFlags write SetFlags;
     //property HelpSystem : IHelpSystem read FHelpSystem;
     property Hint: string read FHint write SetHint;
     property HintColor: TColor read FHintColor write SetHintColor;
diff -uNr lazarus/lcl/include/application.inc /dos/fpc/lazarus.w/lcl/include/application.inc
--- lazarus/lcl/include/application.inc	2006-05-07 10:53:50.000000000 +0100
+++ /dos/fpc/lazarus.w/lcl/include/application.inc	2006-05-08 21:22:31.000000000 +0100
@@ -424,6 +424,12 @@
   end;
 end;
 
+procedure TApplication.SetFlags(const AValue: TApplicationFlags);
+begin
+  { Only allow AppNoExceptionMessages to be changed }
+  FFlags := Flags - [AppNoExceptionMessages] + AValue*[AppNoExceptionMessages];
+end;
+
 procedure TApplication.SetNavigation(const AValue: TApplicationNavigationOptions
   );
 begin
@@ -876,13 +882,15 @@
   Include(FFlags,AppHandlingException);
   if StopOnException then
     inherited Terminate;
-  // before we do anything, write it down
-  if ExceptObject is Exception then begin
-    DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message);
-  end else begin
-    DebugLn('TApplication.HandleException Strange Exception ');
+  if not (AppNoExceptionMessages in FFlags) then begin
+    // before we do anything, write it down
+    if ExceptObject is Exception then begin
+      DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message);
+    end else begin
+      DebugLn('TApplication.HandleException Strange Exception ');
+    end;
+    DumpExceptionBackTrace;
   end;
-  DumpExceptionBackTrace;
   // release capture and hide all forms with stay on top, so that
   // a message can be shown
   if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0);