MWE: * Fixed string resolving

* Updated exception handling

git-svn-id: trunk@4212 -

debugger/dbgutils.pp

@@ -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);
+    idx := 0;
-    if 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
+  if AnIgnoreCase
-  else idx := Pos(AnEnd, ASource);
+  then S := UpperCase(Source)
-  if idx = 0 
+  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;
+    Result := Source;
-    ASource := '';
+    Source := '';
   end
   else begin
-    Result := Copy(ASource, 1, idx - 1);
+    Result := Copy(Source, 1, idx - 1);
-    Delete(ASource, 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

debugger/debugger.pp

@@ -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
 

ide/debugmanager.pas

@@ -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''.',
+  if AExceptionText = ''
-           [Project1.Title, AExceptionID, AExceptionText]),
+  then msg := Format('Project %s raised exception class ''%s''.', [Project1.Title, AExceptionClass])
-    mtError,[mbOk],0);
+  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