paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 01:19:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

MWE: * Fixed string resolving

Browse Source 
* Updated exception handling

git-svn-id: trunk@4212 -
This commit is contained in:
marc 2003-05-29 17:40:10 +00:00
parent 2f9b4a5c83
commit 5dad254d29
3 changed files with 106 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
debugger/dbgutils.pp
View File

@ -36,7 +36,11 @@ interface
function GetLine(var ABuffer: String): String;
function StripLN(const ALine: String): String;
function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String; overload;
function GetPart(const ASkipTo, AnEnd: String; var ASource: String; const AnIgnoreCase: Boolean): String; overload;
function GetPart(const ASkipTo, AnEnd: array of String; var ASource: String): String; overload;
function GetPart(const ASkipTo, AnEnd: array of String; var ASource: String; const AnIgnoreCase: Boolean): String; overload;
function GetPart(const ASkipTo, AnEnd: array of String; var ASource: String; const AnIgnoreCase, AnUpdateSource: Boolean): String; overload;
function ConvertToCString(const AText: String): String;
const
@ -48,6 +52,9 @@ const
implementation
uses
SysUtils;
function GetLine(var ABuffer: String): String;
var
idx: Integer;
@ -84,31 +91,90 @@ begin
end;
function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
begin
Result := GetPart([ASkipTo], [AnEnd], ASource, False, True);
end;
function GetPart(const ASkipTo, AnEnd: String; var ASource: String; const AnIgnoreCase: Boolean): String; overload;
begin
Result := GetPart([ASkipTo], [AnEnd], ASource, AnIgnoreCase, True);
end;
function GetPart(const ASkipTo, AnEnd: array of String; var ASource: String): String; overload;
begin
Result := GetPart(ASkipTo, AnEnd, ASource, False, True);
end;
function GetPart(const ASkipTo, AnEnd: array of String; var ASource: String; const AnIgnoreCase: Boolean): String; overload;
begin
Result := GetPart(ASkipTo, AnEnd, ASource, AnIgnoreCase, True);
end;
function GetPart(const ASkipTo, AnEnd: array of String; var ASource: String; const AnIgnoreCase, AnUpdateSource: Boolean): String; overload;
var
idx: Integer;
n, i, idx: Integer;
S, Source, Match: String;
HasEscape: Boolean;
begin
if ASkipTo <> ''
Source := ASource;
if High(ASkipTo) >= 0
then begin
idx := Pos(ASkipTo, ASource);
if idx = 0
idx := 0;
HasEscape := False;
if AnIgnoreCase
then S := UpperCase(Source)
else S := Source;
for n := Low(ASkipTo) to High(ASkipTo) do
begin
if ASkipTo[n] = ''
then begin
HasEscape := True;
Continue;
end;
if AnIgnoreCase
then i := Pos(UpperCase(ASkipTo[n]), S)
else i := Pos(ASkipTo[n], S);
if i > idx
then begin
idx := i;
Match := ASkipTo[n];
end;
end;
if (idx = 0) and not HasEscape
then begin
Result := '';
Exit;
end;
Delete(ASource, 1, idx + Length(ASkipTo) - 1);
if idx > 0
then Delete(Source, 1, idx + Length(Match) - 1);
end;
if AnEnd = ''
then idx := 0
else idx := Pos(AnEnd, ASource);
if idx = 0
if AnIgnoreCase
then S := UpperCase(Source)
else S := Source;
idx := MaxInt;
for n := Low(AnEnd) to High(AnEnd) do
begin
if AnEnd[n] = '' then Continue;
if AnIgnoreCase
then i := Pos(UpperCase(AnEnd[n]), S)
else i := Pos(AnEnd[n], S);
if (i > 0) and (i < idx) then idx := i;
end;
if idx = MaxInt
then begin
Result := ASource;
ASource := '';
Result := Source;
Source := '';
end
else begin
Result := Copy(ASource, 1, idx - 1);
Delete(ASource, 1, idx - 1);
Result := Copy(Source, 1, idx - 1);
Delete(Source, 1, idx - 1);
end;
if AnUpdateSource
then ASource := Source;
end;
function ConvertToCString(const AText: String): String;
@ -138,6 +204,10 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.4 2003/05/29 17:40:10 marc
MWE: * Fixed string resolving
* Updated exception handling
Revision 1.3 2003/05/22 23:08:19 marc
MWE: = Moved and renamed debuggerforms so that they can be
modified by the ide

12
debugger/debugger.pp
View File

@ -519,7 +519,7 @@ type
TDBGOutputEvent = procedure(Sender: TObject; const AText: String) of object;
TDBGCurrentLineEvent = procedure(Sender: TObject;
const ALocation: TDBGLocationRec) of object;
TDBGExceptionEvent = procedure(Sender: TObject; const AExceptionID: Integer;
TDBGExceptionEvent = procedure(Sender: TObject; const AExceptionClass: String;
const AExceptionText: String) of object;
TDebugger = class(TObject)
@ -552,7 +552,7 @@ type
function CreateWatches: TDBGWatches; virtual;
procedure DoCurrent(const ALocation: TDBGLocationRec);
procedure DoDbgOutput(const AText: String);
procedure DoException(const AExceptionID: Integer; const AExceptionText: String);
procedure DoException(const AExceptionClass: String; const AExceptionText: String);
procedure DoOutput(const AText: String);
procedure DoState(const OldState: TDBGState);
function ChangeFileName: Boolean; virtual;
@ -771,11 +771,11 @@ begin
if Assigned(FOnDbgOutput) then FOnDbgOutput(Self, AText);
end;
procedure TDebugger.DoException(const AExceptionID: Integer;
procedure TDebugger.DoException(const AExceptionClass: String;
const AExceptionText: String);
begin
if Assigned(FOnException) then
FOnException(Self, AExceptionID, AExceptionText);
FOnException(Self, AExceptionClass, AExceptionText);
end;
procedure TDebugger.DoOutput(const AText: String);
@ -2287,6 +2287,10 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.33 2003/05/29 17:40:10 marc
MWE: * Fixed string resolving
* Updated exception handling
Revision 1.32 2003/05/28 17:40:55 mattias
recuced update notifications

20
ide/debugmanager.pas
View File

@ -71,7 +71,7 @@ type
procedure OnDebuggerCurrentLine(Sender: TObject;
const ALocation: TDBGLocationRec);
procedure OnDebuggerOutput(Sender: TObject; const AText: String);
procedure OnDebuggerException(Sender: TObject; const AExceptionID: Integer;
procedure OnDebuggerException(Sender: TObject; const AExceptionClass: String;
const AExceptionText: String);
private
FDebugger: TDebugger;
@ -448,13 +448,17 @@ end;
//-----------------------------------------------------------------------------
procedure TDebugManager.OnDebuggerException(Sender: TObject;
const AExceptionID: Integer; const AExceptionText: String);
const AExceptionClass: String; const AExceptionText: String);
var
msg: String;
begin
if Destroying then exit;
MessageDlg('Error',
Format('Project %s raised exception class %d with message ''%s''.',
[Project1.Title, AExceptionID, AExceptionText]),
mtError,[mbOk],0);
if AExceptionText = ''
then msg := Format('Project %s raised exception class ''%s''.', [Project1.Title, AExceptionClass])
else msg := Format('Project %s raised exception class ''%s'' with message ''%s''.', [Project1.Title, AExceptionClass, AExceptionText]);
MessageDlg('Error', msg, mtError,[mbOk],0);
end;
procedure TDebugManager.OnDebuggerOutput(Sender: TObject; const AText: String);
@ -1340,6 +1344,10 @@ end.
{ =============================================================================
$Log$
Revision 1.37 2003/05/29 17:40:10 marc
MWE: * Fixed string resolving
* Updated exception handling
Revision 1.36 2003/05/29 07:25:02 mattias
added Destroying flag, debugger now always shuts down