paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-21 03:21:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

application dump stack only if no AppNoExceptionMessages is set

Browse Source 
git-svn-id: trunk@9261 -
This commit is contained in:
mattias 2006-05-13 08:20:31 +00:00
parent e0bb1797fc
commit 003ec5d0f6
3 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
ideintf/helpintf.pas
View File

@ -530,8 +530,6 @@ type
{ THelpDatabases { THelpDatabases
Class for storing all registered THelpDatabase } Class for storing all registered THelpDatabase }
{ THelpDatabases }
THelpDatabases = class THelpDatabases = class
private private
FItems: TList; FItems: TList;
@ -597,6 +595,7 @@ type
function GetNodesForMessage(const AMessage: string; MessageParts: TStrings; function GetNodesForMessage(const AMessage: string; MessageParts: TStrings;
var ListOfNodes: THelpNodeQueryList; var ListOfNodes: THelpNodeQueryList;
var ErrMsg: string): TShowHelpResult; virtual; var ErrMsg: string): TShowHelpResult; virtual;
// Show the help selector
function ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList; function ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList;
var ErrMsg: string; var ErrMsg: string;
var Selection: THelpNodeQuery var Selection: THelpNodeQuery

2
lcl/forms.pp
View File

@ -927,6 +927,7 @@ type
procedure IconChanged(Sender: TObject); procedure IconChanged(Sender: TObject);
function InvokeHelp(Command: Word; Data: Longint): Boolean; function InvokeHelp(Command: Word; Data: Longint): Boolean;
function GetControlAtMouse: TControl; function GetControlAtMouse: TControl;
procedure SetFlags(const AValue: TApplicationFlags);
procedure SetNavigation(const AValue: TApplicationNavigationOptions); procedure SetNavigation(const AValue: TApplicationNavigationOptions);
procedure UpdateMouseControl(NewMouseControl: TControl); procedure UpdateMouseControl(NewMouseControl: TControl);
procedure MouseIdle(const CurrentControl: TControl); procedure MouseIdle(const CurrentControl: TControl);
@ -1035,6 +1036,7 @@ type
write SetCaptureExceptions; write SetCaptureExceptions;
property FindGlobalComponentEnabled: boolean read FFindGlobalComponentEnabled property FindGlobalComponentEnabled: boolean read FFindGlobalComponentEnabled
write FFindGlobalComponentEnabled; write FFindGlobalComponentEnabled;
property Flags: TApplicationFlags read FFlags write SetFlags;
//property HelpSystem : IHelpSystem read FHelpSystem; //property HelpSystem : IHelpSystem read FHelpSystem;
property Hint: string read FHint write SetHint; property Hint: string read FHint write SetHint;
property HintColor: TColor read FHintColor write SetHintColor; property HintColor: TColor read FHintColor write SetHintColor;

20
lcl/include/application.inc
View File

@ -424,6 +424,12 @@ begin
end; end;
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 procedure TApplication.SetNavigation(const AValue: TApplicationNavigationOptions
); );
begin begin
@ -876,13 +882,15 @@ begin
Include(FFlags,AppHandlingException); Include(FFlags,AppHandlingException);
if StopOnException then if StopOnException then
inherited Terminate; inherited Terminate;
// before we do anything, write it down if not (AppNoExceptionMessages in FFlags) then begin
if ExceptObject is Exception then begin // before we do anything, write it down
DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message); if ExceptObject is Exception then begin
end else begin DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message);
DebugLn('TApplication.HandleException Strange Exception '); end else begin
DebugLn('TApplication.HandleException Strange Exception ');
end;
DumpExceptionBackTrace;
end; end;
DumpExceptionBackTrace;
// release capture and hide all forms with stay on top, so that // release capture and hide all forms with stay on top, so that
// a message can be shown // a message can be shown
if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0); if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0);