MWE:

+ Published OnClick for TMenuItem
  + Published PopupMenu property for TEdit and TMemo (Doesn't work yet)
  * Fixed debugger running twice
  + Added Debugger output form
  * Enabled breakpoints

git-svn-id: trunk@1450 -

.gitattributes

@@ -58,9 +58,7 @@ components/synedit/synhighlighterxml.pas svneol=native#text/pascal
 components/synedit/syntextdrawer.pp svneol=native#text/pascal
 debugger/breakpointsdlg.pp svneol=native#text/pascal
 debugger/cmdlinedebugger.pp svneol=native#text/pascal
-debugger/dbgbreakpoint.pp svneol=native#text/pascal
 debugger/dbgoutputform.pp svneol=native#text/pascal
-debugger/dbgwatch.pp svneol=native#text/pascal
 debugger/debugger.pp svneol=native#text/pascal
 debugger/gdbdebugger.pp svneol=native#text/pascal
 debugger/gdbmidebugger.pp svneol=native#text/pascal

debugger/cmdlinedebugger.pp

@@ -287,7 +287,7 @@ var
   WaitSet: Integer;
   Idx, Count: Integer;
 begin                
-  WriteLN('[TCmdLineDebugger.GetOutput] Enter');
+//  WriteLN('[TCmdLineDebugger.GetOutput] Enter');
 
   if (FTargetProcess = nil)
   then OutHandle := 0
@@ -343,11 +343,13 @@ begin
     end;
   until OutputBuf = WaitPrompt; 
   
-  WriteLN('[TCmdLineDebugger.GetOutput] Leave');
+//  WriteLN('[TCmdLineDebugger.GetOutput] Leave');
 end;
 
 procedure TCmdLineDebugger.KillTargetProcess;
 begin           
+  if FTargetProcess = nil then Exit;
+  
   FTargetProcess.Terminate(0);
   FTargetProcess.WaitOnExit;
   try
@@ -364,7 +366,7 @@ const
 begin
   if FDbgProcess <> nil 
   then begin
-    WriteLN(Format('[TCmdLineDebugger.SendCmd] CMD: <%s>', [ACommand]));
+//    WriteLN(Format('[TCmdLineDebugger.SendCmd] CMD: <%s>', [ACommand]));
     DoDbgOutput('<' + ACommand + '>');
     if ACommand <> ''
     then FDbgProcess.Input.Write(ACommand[1], Length(ACommand));
@@ -387,6 +389,14 @@ end;
 end.
 { =============================================================================
   $Log$
+  Revision 1.6  2002/02/20 23:33:23  lazarus
+  MWE:
+    + Published OnClick for TMenuItem
+    + Published PopupMenu property for TEdit and TMemo (Doesn't work yet)
+    * Fixed debugger running twice
+    + Added Debugger output form
+    * Enabled breakpoints
+
   Revision 1.5  2002/02/06 08:58:29  lazarus
   MG: fixed compiler warnings and asking to create non existing files
 

debugger/dbgbreakpoint.pp

@@ -1,400 +0,0 @@
-{ $Id$ }
-{                        ---------------------------------------  
-                         DBGBreakpoint.pp  -  Breakpoint classes
-                         --------------------------------------- 
- 
- @created(Wed Feb 25st WET 2001)
- @lastmod($Date$)
- @author(Marc Weustink <marc@@dommelstein.net>)                       
-
- This unit contains the class definitions of the 
- Breakpoints used by the debugger
- 
-/*************************************************************************** 
- *                                                                         * 
- *   This program is free software; you can redistribute it and/or modify  * 
- *   it under the terms of the GNU General Public License as published by  * 
- *   the Free Software Foundation; either version 2 of the License, or     * 
- *   (at your option) any later version.                                   * 
- *                                                                         * 
- ***************************************************************************/ 
-} 
-unit DBGBreakpoint;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes;
-
-type
-  TDBGBreakPointActions = (bpaStop, bpaEnableGroup, bpaDisableGroup);
-
-  
-  TDBGBreakPointGroup = class;
-  TDBGBreakPointClass = class of TDBGBreakPoint;
-  TDBGBreakPoint = class(TCollectionItem)
-  private
-    FDebugger: TObject;  // reference to our debugger
-    FGroup: TDBGBreakPointGroup;
-    FValid: Boolean;
-    FEnabled: Boolean;
-    FHitCount: Integer;
-    FExpression: String;                                             
-    FSource: String; 
-    FLine: Integer;
-    FActions: TDBGBreakPointActions;
-    procedure SetActions(const AValue: TDBGBreakPointActions); 
-    procedure SetEnabled(const AValue: Boolean); 
-    procedure SetExpression(const AValue: String); 
-    procedure SetGroup(const AValue: TDBGBreakPointGroup);
-  protected                                        
-    procedure AssignTo(Dest: TPersistent); override;
-    procedure DoActionChange; virtual;
-    procedure DoEnableChange; virtual;
-    procedure DoExpressionChange; virtual;
-    procedure DoStateChange; virtual;
-    procedure SetHitCount(const AValue: Integer); 
-    procedure SetLocation(const ASource: String; const ALine: Integer); virtual;
-    procedure SetValid(const AValue: Boolean); 
-    property  Debugger: TObject read FDebugger;
-  public
-    procedure AddDisableGroup(const AGroup: TDBGBreakPointGroup);
-    procedure AddEnableGroup(const AGroup: TDBGBreakPointGroup);
-    constructor Create(ACollection: TCollection); override;
-    procedure RemoveDisableGroup(const AGroup: TDBGBreakPointGroup);
-    procedure RemoveEnableGroup(const AGroup: TDBGBreakPointGroup);
-    property Actions: TDBGBreakPointActions read FActions write SetActions;
-    property Enabled: Boolean read FEnabled write SetEnabled;
-    property Group: TDBGBreakPointGroup read FGroup write SetGroup;
-    property HitCount: Integer read FHitCount;
-    property Expression: String read FExpression write SetExpression;
-    property Source: String read FSource; 
-    property Line: Integer read FLine;
-    property Valid: Boolean read FValid;
-  end;
-
-  TDBGBreakPoints = class(TCollection)
-  private
-    FDebugger: TObject;  // reference to our debugger
-    function GetItem(const AnIndex: Integer): TDBGBreakPoint;
-    procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint);
-  protected
-    procedure DoStateChange;
-  public 
-    constructor Create(const ADebugger: TObject; const ABreakPointClass: TDBGBreakPointClass);
-    function Add(const ASource: String; const ALine: Integer): TDBGBreakPoint;
-    function Find(const ASource: String; const ALine: Integer): TDBGBreakPoint;
-    property Items[const AnIndex: Integer]: TDBGBreakPoint read GetItem write SetItem; default;
-  end;
-  
-  TDBGBreakPointGroup = class(TCollectionItem)
-  private
-    FEnabled: Boolean;
-    FName: String;
-    FBreakpoints: TList;
-    function GetBreakpoint(const AIndex: Integer): TDBGBreakPoint;
-    procedure SetEnabled(const AValue: Boolean);
-    procedure SetName(const AValue: String);
-  protected
-  public
-    function Add(const ABreakPoint: TDBGBreakPoint): Integer;
-    function Count: Integer;
-    constructor Create(ACollection: TCollection); override;
-    procedure Delete(const AIndex: Integer);
-    destructor Destroy; override;
-    function Remove(const ABreakPoint: TDBGBreakPoint): Integer;
-    property Breakpoints[const AIndex: Integer]: TDBGBreakPoint read GetBreakpoint;
-    property Enabled: Boolean read FEnabled write SetEnabled;
-    property Name: String read FName write SetName;
-  end;
-
-  TDBGBreakPointGroups = class(TCollection)
-  private                     
-    function GetItem(const AnIndex: Integer): TDBGBreakPointGroup;
-    procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPointGroup);
-  protected
-  public
-    constructor Create;
-    property Items[const AnIndex: Integer]: TDBGBreakPointGroup read GetItem write SetItem; default;
-  end;
-
-
-implementation
-
-uses
-  Debugger;      
-  
-{ TDBGBreakPoint }
-
-procedure TDBGBreakPoint.AddDisableGroup(const AGroup: TDBGBreakPointGroup);
-begin
-end;
-
-procedure TDBGBreakPoint.AddEnableGroup(const AGroup: TDBGBreakPointGroup);
-begin
-end;
-
-procedure TDBGBreakPoint.AssignTo(Dest: TPersistent);
-begin
-  if Dest is TDBGBreakPoint 
-  then begin
-    TDBGBreakPoint(Dest).SetLocation(FSource, FLine);
-    TDBGBreakPoint(Dest).SetExpression(FExpression);
-    TDBGBreakPoint(Dest).SetActions(FActions);
-    TDBGBreakPoint(Dest).SetEnabled(FEnabled);
-  end
-  else inherited; 
-end;
-
-constructor TDBGBreakPoint.Create(ACollection: TCollection); 
-begin
-  inherited Create(ACollection);
-  FSource := '';
-  FLine := -1;
-  FValid := False;
-  FEnabled := False;
-  FHitCount := 0;
-  FExpression := '';
-  FGroup := nil;
-  FDebugger := TDBGBreakPoints(ACollection).FDebugger;
-end;
-
-procedure TDBGBreakPoint.DoActionChange; 
-begin
-end;
-
-procedure TDBGBreakPoint.DoEnableChange; 
-begin
-end;
-
-procedure TDBGBreakPoint.DoExpressionChange; 
-begin
-end;
-
-procedure TDBGBreakPoint.DoStateChange; 
-begin
-end;
-
-procedure TDBGBreakPoint.RemoveDisableGroup(const AGroup: TDBGBreakPointGroup);
-begin
-end;
-
-procedure TDBGBreakPoint.RemoveEnableGroup(const AGroup: TDBGBreakPointGroup);
-begin
-end;
-
-procedure TDBGBreakPoint.SetActions(const AValue: TDBGBreakPointActions);
-begin
-  if FActions <> AValue
-  then begin
-    FActions := AValue;
-    DoActionChange;
-  end;
-end;
-
-procedure TDBGBreakPoint.SetEnabled(const AValue: Boolean);
-begin
-  if FEnabled <> AValue
-  then begin
-    FEnabled := AValue;
-    DoEnableChange;
-  end;
-end;
-
-procedure TDBGBreakPoint.SetExpression(const AValue: String);
-begin
-  if FExpression <> AValue
-  then begin
-    FExpression := AValue;
-    DoExpressionChange;
-  end;
-end;
-
-procedure TDBGBreakPoint.SetGroup(const AValue: TDBGBreakPointGroup);
-var
-  Grp: TDBGBreakPointGroup;
-begin
-  if FGroup <> AValue
-  then begin
-    
-    if FGroup <> nil 
-    then begin
-      Grp := FGroup;
-      FGroup := nil;  //  avoid second entrance
-      Grp.Remove(Self);
-    end;
-    FGroup := AValue;
-    if FGroup <> nil 
-    then begin
-      FGroup.Add(Self);
-    end;
-  end;
-end;
-
-procedure TDBGBreakPoint.SetHitCount(const AValue: Integer);
-begin
-  FHitCount := AValue;
-end;
-
-procedure TDBGBreakPoint.SetLocation(const ASource: String; const ALine: Integer); 
-begin
-  FSource := ASource;
-  FLine := ALine;
-end;
-
-procedure TDBGBreakPoint.SetValid(const AValue: Boolean);
-begin
-  FValid := AValue;
-end;
-
-{ TDBGBreakPoints }
-
-function TDBGBreakPoints.Add(const ASource: String; const ALine: Integer): TDBGBreakPoint;
-begin
-  Result := TDBGBreakPoint(inherited Add);
-  Result.SetLocation(ASource, ALine);
-end;
-
-constructor TDBGBreakPoints.Create(const ADebugger: TObject; const ABreakPointClass: TDBGBreakPointClass);
-begin
-  inherited Create(ABreakPointClass);
-  FDebugger := ADebugger;
-end;
-
-procedure TDBGBreakPoints.DoStateChange;
-var
-  n: Integer;
-begin
-  for n := 0 to Count - 1 do
-    GetItem(n).DoStateChange;
-end;
-
-function TDBGBreakPoints.Find(const ASource: String; const ALine: Integer): TDBGBreakPoint;
-var
-  n: Integer;
-begin
-  for n := 0 to Count - 1 do
-  begin
-    Result := GetItem(n);
-    if  (Result.Line = ALine)
-    and (Result.Source = ASource)
-    then Exit;
-  end;    
-  Result := nil;
-end;
-
-function TDBGBreakPoints.GetItem(const AnIndex: Integer): TDBGBreakPoint;
-begin
-  Result := TDBGBreakPoint(inherited GetItem(AnIndex));
-end;
-
-procedure TDBGBreakPoints.SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint);
-begin  
-  SetItem(AnIndex, AValue);   
-end;
-
-{ TDBGBreakPointGroup }
-
-function TDBGBreakPointGroup.Add(const ABreakPoint: TDBGBreakPoint): Integer;
-begin
-  Result := FBreakpoints.IndexOf(ABreakPoint); //avoid dups
-  if Result = -1
-  then begin
-    Result := FBreakpoints.Add(ABreakPoint);
-    ABreakpoint.Group := Self;
-  end;
-end;
-
-function TDBGBreakPointGroup.Count: Integer;
-begin
-  Result := FBreakpoints.Count;
-end;
-
-constructor TDBGBreakPointGroup.Create(ACollection: TCollection); 
-begin
-  inherited Create(ACollection);
-  FBreakpoints := TList.Create;
-  FEnabled := True;
-end;
-
-procedure TDBGBreakPointGroup.Delete(const AIndex: Integer);
-begin
-  Remove(TDBGBreakPoint(FBreakPoints[AIndex]));
-end;
-
-destructor TDBGBreakPointGroup.Destroy; 
-begin         
-  FBreakpoints.Free;
-  inherited Destroy;
-end;
-
-function TDBGBreakPointGroup.GetBreakpoint(const AIndex: Integer): TDBGBreakPoint;
-begin
-  Result := TDBGBreakPoint(FBreakPoints[AIndex]);
-end;
-
-function TDBGBreakPointGroup.Remove(const ABreakPoint: TDBGBreakPoint): Integer;
-begin
-  Result := FBreakpoints.Remove(ABreakPoint);
-  if ABreakpoint.Group = Self
-  then ABreakpoint.Group := nil;
-end;
-
-procedure TDBGBreakPointGroup.SetEnabled(const AValue: Boolean);
-var
-  n: Integer;
-begin
-  if FEnabled <> AValue
-  then begin
-    FEnabled := AValue;
-    for n := 0 to FBreakPoints.Count - 1 do
-      TDBGBreakpoint(FBreakPoints[n]).Enabled := FEnabled;
-  end;
-end;
-
-procedure TDBGBreakPointGroup.SetName(const AValue: String);
-begin
-  FName := AValue;
-end;
-
-{ TDBGBreakPointGroups }
-
-constructor TDBGBreakPointGroups.Create; 
-begin
-  inherited Create(TDBGBreakPointGroup);
-end;
-
-function TDBGBreakPointGroups.GetItem(const AnIndex: Integer): TDBGBreakPointGroup;
-begin
-  Result := TDBGBreakPointGroup(inherited GetItem(AnIndex));
-end;
-
-procedure TDBGBreakPointGroups.SetItem(const AnIndex: Integer; const AValue: TDBGBreakPointGroup);
-begin
-  inherited SetItem(AnIndex, AValue);
-end;
-
-end.
-{ =============================================================================
-  $Log$
-  Revision 1.6  2002/02/05 23:16:48  lazarus
-  MWE: * Updated tebugger
-       + Added debugger to IDE
-
-  Revision 1.5  2001/11/06 23:59:12  lazarus
-  MWE: + Initial breakpoint support
-       + Added exeption handling on process.free
-
-  Revision 1.4  2001/11/05 00:12:51  lazarus
-  MWE: First steps of a debugger.
-
-  Revision 1.3  2001/10/18 13:01:31  lazarus
-  MG: fixed speedbuttons numglyphs>1 and started IDE debugging
-
-  Revision 1.2  2001/02/25 16:44:57  lazarus
-  MWE:
-    + Added header and footer
-
-}

debugger/dbgoutputform.lrc

@@ -1,7 +1,9 @@
   LazarusResources.Add('TDbgOutputForm','FORMDATA',
     'TPF0'#14'TDbgOutputForm'#14'DbgOutputForm1'#7'CAPTION'#6#12'Debug output'
-    +#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#3'TOP'#2#10#4
+    +#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11
-    +'LEFT'#2#10#6'HEIGHT'#3#150#0#5'WIDTH'#3'-'#1#0#5'TMemo'#9'txtOutput'#4'L'
+    +'FormDestroy'#3'TOP'#2#10#4'LEFT'#2#10#6'HEIGHT'#3#200#0#5'WIDTH'#3#144#1
-    +'eft'#2#8#3'Top'#2'h'#5'Width'#3'X'#2#6'Height'#3#150#0#5'Align'#7#8'alCl'
+    +#0#5'TMemo'#9'txtOutput'#4'Left'#2#8#3'Top'#2'h'#5'Width'#3'X'#2#6'Height'
-    +'ient'#0#0#0
+    +#3#150#0#5'Align'#7#8'alClient'#9'PopupMenu'#7#8'mnuPopup'#0#0#10'TPopupM'
+    +'enu'#8'mnuPopup'#4'Left'#3#144#1#3'Top'#2'`'#0#9'TMenuItem'#8'popClear'#7
+    +'Caption'#6#6'&Clear'#7'OnClick'#7#13'popClearClick'#0#0#0#0
   );

debugger/dbgoutputform.pp

@@ -25,18 +25,23 @@ interface
 
 uses
   Classes, Graphics, Controls, Forms, Dialogs, LResources,
-  Buttons, StdCtrls, Debugger;
+  Buttons, StdCtrls, Menus;
 
 type
   TDbgOutputForm = class(TForm)
     txtOutput: TMemo;
+    mnuPopup: TPopupMenu;
+    popClear: TMenuItem;
+    procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
+    procedure popClearClick(Sender: TObject);
   private
   protected
     procedure Loaded; override;
   public
     procedure AddText(const AText: String);
+    procedure Clear;
   end;
 
 implementation
@@ -46,6 +51,16 @@ begin
   txtOutput.Lines.Add(AText);
 end;
 
+procedure TDbgOutputForm.Clear;
+begin             
+  txtOutput.Lines.Clear; 
+end;
+
+procedure TDbgOutputForm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+  Action := caFree;
+end;
+
 procedure TDbgOutputForm.FormCreate(Sender: TObject);
 begin
   txtOutput.Lines.Clear;
@@ -63,12 +78,25 @@ begin
   txtOutput.Scrollbars := ssBoth;
 end;
 
+procedure TDbgOutputForm.popClearClick(Sender: TObject);
+begin
+  Clear;
+end;
+
 initialization
   {$I dbgoutputform.lrc}
 
 end.
 { =============================================================================
   $Log$
+  Revision 1.2  2002/02/20 23:33:24  lazarus
+  MWE:
+    + Published OnClick for TMenuItem
+    + Published PopupMenu property for TEdit and TMemo (Doesn't work yet)
+    * Fixed debugger running twice
+    + Added Debugger output form
+    * Enabled breakpoints
+
   Revision 1.1  2001/11/05 00:12:51  lazarus
   MWE: First steps of a debugger.
 

debugger/dbgwatch.pp

@@ -1,171 +0,0 @@
-{ $Id$ }
-{                        -----------------------------------  
-                         DBGWatch.pp  -  Debug Watch classes
-                         ----------------------------------- 
- 
- @created(Wed Feb 25st WET 2001)
- @lastmod($Date$)
- @author(Marc Weustink <marc@@dommelstein.net>)                       
-
- This unit contains the class definitions of the 
- Watches used by the debugger
- 
-/*************************************************************************** 
- *                                                                         * 
- *   This program is free software; you can redistribute it and/or modify  * 
- *   it under the terms of the GNU General Public License as published by  * 
- *   the Free Software Foundation; either version 2 of the License, or     * 
- *   (at your option) any later version.                                   * 
- *                                                                         * 
- ***************************************************************************/ 
-} 
-unit DBGWatch;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes;
-
-type
-  TDBGWatchClass = class of TDBGWatch;
-  TDBGWatch = class(TCollectionItem)
-  private
-    FDebugger: TObject;  // reference to our debugger
-    FEnabled: Boolean;
-    FExpression: String;
-    //FValue: String;
-    FOnChange: TNotifyEvent;
-    procedure SetEnabled(const AValue: Boolean);
-  protected
-    procedure DoEnableChange; virtual;
-    procedure DoStateChange; virtual; 
-    function  GetValue: String; virtual;
-    function  GetValid: Boolean; virtual;
-    procedure SetExpression(const AValue: String); virtual;
-    procedure SetValue(const AValue: String); virtual;
-    property  Debugger: TObject read FDebugger;
-  public
-    constructor Create(ACollection: TCollection); override;
-    property Enabled: Boolean read FEnabled write SetEnabled;
-    property Expression: String read FExpression write SetExpression;
-    property Valid: Boolean read GetValid;
-    property Value: String read GetValue write SetValue;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
-  end;
-
-  TDBGWatches = class(TCollection)
-  private
-    FDebugger: TObject;  // reference to our debugger
-    function GetItem(const AnIndex: Integer): TDBGWatch;
-    procedure SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
-  protected
-    procedure DoStateChange;  
-  public
-    constructor Create(const ADebugger: TObject; const AWatchClass: TDBGWatchClass); 
-    property Items[const AnIndex: Integer]: TDBGWatch read GetItem write SetItem; default;
-  end;
-  
-implementation 
-
-uses
-  Debugger;      
-
-{ TDBGWatch }
-
-constructor TDBGWatch.Create(ACollection: TCollection); 
-begin
-  inherited Create(ACollection);
-  FEnabled := False;
-  FDebugger := TDBGWatches(ACollection).FDebugger;
-end;
-
-procedure TDBGWatch.DoEnableChange; 
-begin
-end;
-
-procedure TDBGWatch.DoStateChange;  
-begin
-end;
-
-function TDBGWatch.GetValid: Boolean;
-begin
-  Result := False;
-end;
-
-function TDBGWatch.GetValue: String;
-begin
-  if Valid 
-  then Result := '<unknown>'
-  else Result := '<invalid>';
-end;
-
-procedure TDBGWatch.SetEnabled(const AValue: Boolean);
-begin
-  if FEnabled <> AValue
-  then begin
-    FEnabled := AValue;
-    DoEnableChange;
- end;
-end;
-
-procedure TDBGWatch.SetExpression(const AValue: String);
-begin
-end;
-
-procedure TDBGWatch.SetValue(const AValue: String);
-begin
-end;
-
-{ TDBGWatches }
-
-constructor TDBGWatches.Create(const ADebugger: TObject; const AWatchClass: TDBGWatchClass);
-begin                   
-  FDebugger := ADebugger;
-  inherited Create(AWatchClass);
-end;
-
-procedure TDBGWatches.DoStateChange;
-var
-  n: Integer;
-begin
-  for n := 0 to Count - 1 do
-    GetItem(n).DoStateChange;
-end;
-
-function TDBGWatches.GetItem(const AnIndex: Integer): TDBGWatch;
-begin
-  Result := TDBGWatch(inherited GetItem(AnIndex));
-end;
-
-procedure TDBGWatches.SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
-begin
-  inherited SetItem(AnIndex, AValue);
-end;
-
-end.
-{ =============================================================================
-  $Log$
-  Revision 1.7  2002/02/06 08:58:29  lazarus
-  MG: fixed compiler warnings and asking to create non existing files
-
-  Revision 1.6  2002/02/05 23:16:48  lazarus
-  MWE: * Updated tebugger
-       + Added debugger to IDE
-
-  Revision 1.5  2001/11/06 23:59:13  lazarus
-  MWE: + Initial breakpoint support
-       + Added exeption handling on process.free
-
-  Revision 1.4  2001/11/05 00:12:51  lazarus
-  MWE: First steps of a debugger.
-
-  Revision 1.3  2001/10/18 13:01:31  lazarus
-  MG: fixed speedbuttons numglyphs>1 and started IDE debugging
-
-  Revision 1.2  2001/02/25 16:44:57  lazarus
-  MWE:
-    + Added header and footer
-
-}

debugger/debugger.pp

@@ -27,7 +27,7 @@ unit Debugger;
 interface
 
 uses
-  Classes, DBGWatch, DBGBreakpoint;
+  Classes;
 
 type
   TDBGLocationRec = record
@@ -72,8 +72,141 @@ type
   
 *)  
 
+
+  TDBGBreakPointAction = (bpaStop, bpaEnableGroup, bpaDisableGroup);
+  TDBGBreakPointActions =set of TDBGBreakPointAction;
+
+  TDebugger = class;
+  TDBGBreakPointGroup = class;
+  TDBGBreakPointClass = class of TDBGBreakPoint;
+  TDBGBreakPoint = class(TCollectionItem)
+  private
+    FDebugger: TDebugger;  // reference to our debugger
+    FGroup: TDBGBreakPointGroup;
+    FValid: Boolean;
+    FEnabled: Boolean;
+    FHitCount: Integer;
+    FExpression: String;                                             
+    FSource: String; 
+    FLine: Integer;
+    FFirstRun: Boolean;
+    FActions: TDBGBreakPointActions;
+    procedure SetActions(const AValue: TDBGBreakPointActions); 
+    procedure SetEnabled(const AValue: Boolean); 
+    procedure SetExpression(const AValue: String); 
+    procedure SetGroup(const AValue: TDBGBreakPointGroup);
+  protected                                        
+    procedure AssignTo(Dest: TPersistent); override;
+    procedure DoActionChange; virtual;
+    procedure DoEnableChange; virtual;
+    procedure DoExpressionChange; virtual;
+    procedure DoStateChange; virtual;
+    procedure SetHitCount(const AValue: Integer); 
+    procedure SetLocation(const ASource: String; const ALine: Integer); virtual;
+    procedure SetValid(const AValue: Boolean); 
+    property  Debugger: TDebugger read FDebugger;
+  public
+    procedure AddDisableGroup(const AGroup: TDBGBreakPointGroup);
+    procedure AddEnableGroup(const AGroup: TDBGBreakPointGroup);
+    constructor Create(ACollection: TCollection); override;
+    procedure RemoveDisableGroup(const AGroup: TDBGBreakPointGroup);
+    procedure RemoveEnableGroup(const AGroup: TDBGBreakPointGroup);
+    property Actions: TDBGBreakPointActions read FActions write SetActions;
+    property Enabled: Boolean read FEnabled write SetEnabled;
+    property Group: TDBGBreakPointGroup read FGroup write SetGroup;
+    property HitCount: Integer read FHitCount;
+    property Expression: String read FExpression write SetExpression;
+    property Source: String read FSource; 
+    property Line: Integer read FLine;
+    property Valid: Boolean read FValid;
+  end;
+
+  TDBGBreakPoints = class(TCollection)
+  private
+    FDebugger: TDebugger;  // reference to our debugger
+    function GetItem(const AnIndex: Integer): TDBGBreakPoint;
+    procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint);
+  protected
+    procedure DoStateChange;
+  public 
+    constructor Create(const ADebugger: TDebugger; const ABreakPointClass: TDBGBreakPointClass);
+    function Add(const ASource: String; const ALine: Integer): TDBGBreakPoint;
+    function Find(const ASource: String; const ALine: Integer): TDBGBreakPoint;
+    property Items[const AnIndex: Integer]: TDBGBreakPoint read GetItem write SetItem; default;
+  end;
+  
+  TDBGBreakPointGroup = class(TCollectionItem)
+  private
+    FEnabled: Boolean;
+    FName: String;
+    FBreakpoints: TList;
+    function GetBreakpoint(const AIndex: Integer): TDBGBreakPoint;
+    procedure SetEnabled(const AValue: Boolean);
+    procedure SetName(const AValue: String);
+  protected
+  public
+    function Add(const ABreakPoint: TDBGBreakPoint): Integer;
+    function Count: Integer;
+    constructor Create(ACollection: TCollection); override;
+    procedure Delete(const AIndex: Integer);
+    destructor Destroy; override;
+    function Remove(const ABreakPoint: TDBGBreakPoint): Integer;
+    property Breakpoints[const AIndex: Integer]: TDBGBreakPoint read GetBreakpoint;
+    property Enabled: Boolean read FEnabled write SetEnabled;
+    property Name: String read FName write SetName;
+  end;
+
+  TDBGBreakPointGroups = class(TCollection)
+  private                     
+    function GetItem(const AnIndex: Integer): TDBGBreakPointGroup;
+    procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPointGroup);
+  protected
+  public
+    constructor Create;
+    property Items[const AnIndex: Integer]: TDBGBreakPointGroup read GetItem write SetItem; default;
+  end;
+
+  TDBGWatchClass = class of TDBGWatch;
+  TDBGWatch = class(TCollectionItem)
+  private
+    FDebugger: TDebugger;  // reference to our debugger
+    FEnabled: Boolean;
+    FExpression: String;
+    //FValue: String;
+    FOnChange: TNotifyEvent;
+    procedure SetEnabled(const AValue: Boolean);
+  protected
+    procedure DoEnableChange; virtual;
+    procedure DoStateChange; virtual; 
+    function  GetValue: String; virtual;
+    function  GetValid: Boolean; virtual;
+    procedure SetExpression(const AValue: String); virtual;
+    procedure SetValue(const AValue: String); virtual;
+    property  Debugger: TDebugger read FDebugger;
+  public
+    constructor Create(ACollection: TCollection); override;
+    property Enabled: Boolean read FEnabled write SetEnabled;
+    property Expression: String read FExpression write SetExpression;
+    property Valid: Boolean read GetValid;
+    property Value: String read GetValue write SetValue;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+  end;
+
+  TDBGWatches = class(TCollection)
+  private
+    FDebugger: TDebugger;  // reference to our debugger
+    function GetItem(const AnIndex: Integer): TDBGWatch;
+    procedure SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
+  protected
+    procedure DoStateChange;  
+  public
+    constructor Create(const ADebugger: TDebugger; const AWatchClass: TDBGWatchClass); 
+    property Items[const AnIndex: Integer]: TDBGWatch read GetItem write SetItem; default;
+  end;
+
   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; const AExceptionText: String) of object;
 
   TDebugger = class(TObject)
   private
@@ -84,6 +217,7 @@ type
     FState: TDBGState;
     FWatches: TDBGWatches;
     FOnCurrent: TDBGCurrentLineEvent;
+    FOnException: TDBGExceptionEvent;
     FOnOutput: TDBGOutputEvent;
     FOnDbgOutput: TDBGOutputEvent;
     FOnState: TNotifyEvent;
@@ -94,6 +228,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 DoOutput(const AText: String);
     procedure DoState;
     function  GetCommands: TDBGCommands; 
@@ -103,6 +238,7 @@ type
     procedure SetState(const AValue: TDBGState); 
   public
     constructor Create; {virtual; Virtual constructor makes no sense}
+                        //MWE: there will be a day that they do make sense :-)
     destructor Destroy; override;
     
     procedure Init; virtual;                         // Initializes the debugger
@@ -120,9 +256,10 @@ type
     property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups;      // list of all breakpointgroups
     property Commands: TDBGCommands read GetCommands;                            // All current available commands of the debugger
     property FileName: String read FFileName write SetFileName;                  // The name of the exe to be debugged
-    property State: TDBGState read FState;                                     // The current stete of the debugger    
+    property State: TDBGState read FState;                                       // The current state of the debugger    
     property Watches: TDBGWatches read FWatches;                                 // list of all watches localvars etc
     property OnCurrent: TDBGCurrentLineEvent read FOnCurrent write FOnCurrent;   // Passes info about the current line being debugged
+    property OnException: TDBGExceptionEvent read FOnException write FOnException;  // Fires when the debugger received an exeption
     property OnState: TNotifyEvent read FOnState write FOnState;                 // Fires when the current state of the debugger changes
     property OnOutput: TDBGOutputEvent read FOnOutput write FOnOutput;           // Passes all output of the debugged target
     property OnDbgOutput: TDBGOutputEvent read FOnDbgOutput write FOnDbgOutput;  // Passes all debuggeroutput        
@@ -143,7 +280,9 @@ const
   {dsError} []
   );
 
+{ =========================================================================== }
 { TDebugger }
+{ =========================================================================== }
 
 constructor TDebugger.Create;
 begin
@@ -201,6 +340,11 @@ begin
   if Assigned(FOnDbgOutput) then FOnDbgOutput(Self, AText);
 end;
 
+procedure TDebugger.DoException(const AExceptionID: Integer; const AExceptionText: String);
+begin
+  if Assigned(FOnException) then FOnException(Self, AExceptionID, AExceptionText);
+end;
+
 procedure TDebugger.DoOutput(const AText: String);
 begin
   if Assigned(FOnOutput) then FOnOutput(Self, AText);
@@ -265,10 +409,13 @@ begin
   then begin 
     if FState in [dsRun, dsPause]
     then Stop;        
+    // Reset state
+    FFileName := '';
+    SetState(dsIdle); 
+    
     FFileName := AValue;
-    if FFilename = ''
+    if FFilename <> ''
-    then SetState(dsIdle)
+    then SetState(dsStop); 
-    else SetState(dsStop); 
   end;
 end;
 
@@ -277,6 +424,8 @@ begin
   if AValue <> FState 
   then begin
     FState := AValue;
+    FBreakpoints.DoStateChange;
+    FWatches.DoStateChange;
     DoState;
   end;
 end;
@@ -296,9 +445,365 @@ begin
   ReqCmd(dcStop, []);
 end;
 
+{ =========================================================================== }
+{ TDBGBreakPoint }
+{ =========================================================================== }
+
+procedure TDBGBreakPoint.AddDisableGroup(const AGroup: TDBGBreakPointGroup);
+begin
+end;
+
+procedure TDBGBreakPoint.AddEnableGroup(const AGroup: TDBGBreakPointGroup);
+begin
+end;
+
+procedure TDBGBreakPoint.AssignTo(Dest: TPersistent);
+begin
+  if Dest is TDBGBreakPoint 
+  then begin
+    TDBGBreakPoint(Dest).SetLocation(FSource, FLine);
+    TDBGBreakPoint(Dest).SetExpression(FExpression);
+    TDBGBreakPoint(Dest).SetActions(FActions);
+    TDBGBreakPoint(Dest).SetEnabled(FEnabled);
+  end
+  else inherited; 
+end;
+
+constructor TDBGBreakPoint.Create(ACollection: TCollection); 
+begin
+  inherited Create(ACollection);
+  FSource := '';
+  FLine := -1;
+  FValid := False;
+  FEnabled := False;
+  FHitCount := 0;
+  FExpression := '';
+  FGroup := nil;      
+  FFirstRun := True;  
+  FActions := [bpaStop];
+  FDebugger := TDBGBreakPoints(ACollection).FDebugger;
+end;
+
+procedure TDBGBreakPoint.DoActionChange; 
+begin
+end;
+
+procedure TDBGBreakPoint.DoEnableChange; 
+begin
+end;
+
+procedure TDBGBreakPoint.DoExpressionChange; 
+begin
+end;
+
+procedure TDBGBreakPoint.DoStateChange; 
+begin  
+  case Debugger.State of
+    dsStop, dsIdle: begin
+      FFirstRun := True;
+    end;
+    dsRun: begin
+      if FFirstRun 
+      then begin
+        FHitCount := 0;
+        FFirstRun := False;
+      end;
+    end;
+  end;  
+end;
+
+procedure TDBGBreakPoint.RemoveDisableGroup(const AGroup: TDBGBreakPointGroup);
+begin
+end;
+
+procedure TDBGBreakPoint.RemoveEnableGroup(const AGroup: TDBGBreakPointGroup);
+begin
+end;
+
+procedure TDBGBreakPoint.SetActions(const AValue: TDBGBreakPointActions);
+begin
+  if FActions <> AValue
+  then begin
+    FActions := AValue;
+    DoActionChange;
+  end;
+end;
+
+procedure TDBGBreakPoint.SetEnabled(const AValue: Boolean);
+begin
+  if FEnabled <> AValue
+  then begin
+    FEnabled := AValue;
+    DoEnableChange;
+  end;
+end;
+
+procedure TDBGBreakPoint.SetExpression(const AValue: String);
+begin
+  if FExpression <> AValue
+  then begin
+    FExpression := AValue;
+    DoExpressionChange;
+  end;
+end;
+
+procedure TDBGBreakPoint.SetGroup(const AValue: TDBGBreakPointGroup);
+var
+  Grp: TDBGBreakPointGroup;
+begin
+  if FGroup <> AValue
+  then begin
+    
+    if FGroup <> nil 
+    then begin
+      Grp := FGroup;
+      FGroup := nil;  //  avoid second entrance
+      Grp.Remove(Self);
+    end;
+    FGroup := AValue;
+    if FGroup <> nil 
+    then begin
+      FGroup.Add(Self);
+    end;
+  end;
+end;
+
+procedure TDBGBreakPoint.SetHitCount(const AValue: Integer);
+begin
+  FHitCount := AValue;
+end;
+
+procedure TDBGBreakPoint.SetLocation(const ASource: String; const ALine: Integer); 
+begin
+  FSource := ASource;
+  FLine := ALine;
+end;
+
+procedure TDBGBreakPoint.SetValid(const AValue: Boolean);
+begin
+  FValid := AValue;
+end;
+
+{ =========================================================================== }
+{ TDBGBreakPoints }
+{ =========================================================================== }
+
+function TDBGBreakPoints.Add(const ASource: String; const ALine: Integer): TDBGBreakPoint;
+begin
+  Result := TDBGBreakPoint(inherited Add);
+  Result.SetLocation(ASource, ALine);
+end;
+
+constructor TDBGBreakPoints.Create(const ADebugger: TDebugger; const ABreakPointClass: TDBGBreakPointClass);
+begin
+  inherited Create(ABreakPointClass);
+  FDebugger := ADebugger;
+end;
+
+procedure TDBGBreakPoints.DoStateChange;
+var
+  n: Integer;
+begin
+  for n := 0 to Count - 1 do
+    GetItem(n).DoStateChange;
+end;
+
+function TDBGBreakPoints.Find(const ASource: String; const ALine: Integer): TDBGBreakPoint;
+var
+  n: Integer;
+begin
+  for n := 0 to Count - 1 do
+  begin
+    Result := GetItem(n);
+    if  (Result.Line = ALine)
+    and (Result.Source = ASource)
+    then Exit;
+  end;    
+  Result := nil;
+end;
+
+function TDBGBreakPoints.GetItem(const AnIndex: Integer): TDBGBreakPoint;
+begin
+  Result := TDBGBreakPoint(inherited GetItem(AnIndex));
+end;
+
+procedure TDBGBreakPoints.SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint);
+begin  
+  SetItem(AnIndex, AValue);   
+end;
+
+{ =========================================================================== }
+{ TDBGBreakPointGroup }
+{ =========================================================================== }
+
+function TDBGBreakPointGroup.Add(const ABreakPoint: TDBGBreakPoint): Integer;
+begin
+  Result := FBreakpoints.IndexOf(ABreakPoint); //avoid dups
+  if Result = -1
+  then begin
+    Result := FBreakpoints.Add(ABreakPoint);
+    ABreakpoint.Group := Self;
+  end;
+end;
+
+function TDBGBreakPointGroup.Count: Integer;
+begin
+  Result := FBreakpoints.Count;
+end;
+
+constructor TDBGBreakPointGroup.Create(ACollection: TCollection); 
+begin
+  inherited Create(ACollection);
+  FBreakpoints := TList.Create;
+  FEnabled := True;
+end;
+
+procedure TDBGBreakPointGroup.Delete(const AIndex: Integer);
+begin
+  Remove(TDBGBreakPoint(FBreakPoints[AIndex]));
+end;
+
+destructor TDBGBreakPointGroup.Destroy; 
+begin         
+  FBreakpoints.Free;
+  inherited Destroy;
+end;
+
+function TDBGBreakPointGroup.GetBreakpoint(const AIndex: Integer): TDBGBreakPoint;
+begin
+  Result := TDBGBreakPoint(FBreakPoints[AIndex]);
+end;
+
+function TDBGBreakPointGroup.Remove(const ABreakPoint: TDBGBreakPoint): Integer;
+begin
+  Result := FBreakpoints.Remove(ABreakPoint);
+  if ABreakpoint.Group = Self
+  then ABreakpoint.Group := nil;
+end;
+
+procedure TDBGBreakPointGroup.SetEnabled(const AValue: Boolean);
+var
+  n: Integer;
+begin
+  if FEnabled <> AValue
+  then begin
+    FEnabled := AValue;
+    for n := 0 to FBreakPoints.Count - 1 do
+      TDBGBreakpoint(FBreakPoints[n]).Enabled := FEnabled;
+  end;
+end;
+
+procedure TDBGBreakPointGroup.SetName(const AValue: String);
+begin
+  FName := AValue;
+end;
+
+{ =========================================================================== }
+{ TDBGBreakPointGroups }
+{ =========================================================================== }
+
+constructor TDBGBreakPointGroups.Create; 
+begin
+  inherited Create(TDBGBreakPointGroup);
+end;
+
+function TDBGBreakPointGroups.GetItem(const AnIndex: Integer): TDBGBreakPointGroup;
+begin
+  Result := TDBGBreakPointGroup(inherited GetItem(AnIndex));
+end;
+
+procedure TDBGBreakPointGroups.SetItem(const AnIndex: Integer; const AValue: TDBGBreakPointGroup);
+begin
+  inherited SetItem(AnIndex, AValue);
+end;
+
+{ =========================================================================== }
+{ TDBGWatch }
+{ =========================================================================== }
+
+constructor TDBGWatch.Create(ACollection: TCollection); 
+begin
+  inherited Create(ACollection);
+  FEnabled := False;
+  FDebugger := TDBGWatches(ACollection).FDebugger;
+end;
+
+procedure TDBGWatch.DoEnableChange; 
+begin
+end;
+
+procedure TDBGWatch.DoStateChange;  
+begin
+end;
+
+function TDBGWatch.GetValid: Boolean;
+begin
+  Result := False;
+end;
+
+function TDBGWatch.GetValue: String;
+begin
+  if Valid 
+  then Result := '<unknown>'
+  else Result := '<invalid>';
+end;
+
+procedure TDBGWatch.SetEnabled(const AValue: Boolean);
+begin
+  if FEnabled <> AValue
+  then begin
+    FEnabled := AValue;
+    DoEnableChange;
+ end;
+end;
+
+procedure TDBGWatch.SetExpression(const AValue: String);
+begin
+end;
+
+procedure TDBGWatch.SetValue(const AValue: String);
+begin
+end;
+
+{ =========================================================================== }
+{ TDBGWatches }
+{ =========================================================================== }
+
+constructor TDBGWatches.Create(const ADebugger: TDebugger; const AWatchClass: TDBGWatchClass);
+begin                   
+  FDebugger := ADebugger;
+  inherited Create(AWatchClass);
+end;
+
+procedure TDBGWatches.DoStateChange;
+var
+  n: Integer;
+begin
+  for n := 0 to Count - 1 do
+    GetItem(n).DoStateChange;
+end;
+
+function TDBGWatches.GetItem(const AnIndex: Integer): TDBGWatch;
+begin
+  Result := TDBGWatch(inherited GetItem(AnIndex));
+end;
+
+procedure TDBGWatches.SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
+begin
+  inherited SetItem(AnIndex, AValue);
+end;
+
 end.
 { =============================================================================
   $Log$
+  Revision 1.8  2002/02/20 23:33:24  lazarus
+  MWE:
+    + Published OnClick for TMenuItem
+    + Published PopupMenu property for TEdit and TMemo (Doesn't work yet)
+    * Fixed debugger running twice
+    + Added Debugger output form
+    * Enabled breakpoints
+
   Revision 1.7  2002/02/06 08:58:29  lazarus
   MG: fixed compiler warnings and asking to create non existing files
 

debugger/gdbdebugger.pp

@@ -28,13 +28,22 @@ unit GDBDebugger;
 interface
 
 uses
-  Classes, Process, Debugger, CmdLineDebugger, DBGBreakPoint, DBGWatch;
+  Classes, Process, Debugger, CmdLineDebugger;
+
 
 type                       
+  TGDBProgramInfo = record
+    State: TDBGState;
+    BreakPoint: Integer; // ID of Breakpoint hit
+    Signal: Integer;     // Signal no if we hit one
+    SignalText: String;  // Signal text if we hit one
+  end;
+
 
   TGDBDebugger = class(TCmdLineDebugger)
   private
     FHasSymbols: Boolean;
+    function  FindBreakpoint(const ABreakpoint: Integer): TDBGBreakPoint;
     procedure GDBRun; 
     procedure GDBPause;
     procedure GDBStart;  
@@ -46,7 +55,7 @@ type
     function  SendCommand(const ACommand: String; Values: array of const): TStrings; // internally used by breakpoits and watches
     procedure RunCommand(const ACommand: String);
     function  GetLocation: TDBGLocationRec;
-    function  GetGDBState: TDBGState;
+    function  GetProgramInfo(const AHandleResult: Boolean): TGDBProgramInfo;
   protected
     function  CreateBreakPoints: TDBGBreakPoints; override;
     function  CreateWatches: TDBGWatches; override;
@@ -73,14 +82,17 @@ type
   TGDBBreakPoint = class(TDBGBreakPoint)
   private
     FBreakID: Integer;
+    procedure SetBreakPoint;
   protected
     procedure DoActionChange; override;
     procedure DoEnableChange; override;
     procedure DoExpressionChange; override;
+    procedure DoStateChange; override;
     procedure SetLocation(const ASource: String; const ALine: Integer); override;
   public
     constructor Create(ACollection: TCollection); override;
     destructor Destroy; override;
+    procedure Hit;
   end;
   
   TGDBWatch = class(TDBGWatch)
@@ -94,7 +106,9 @@ type
   public
   end;
   
+{ =========================================================================== }
 { TGDBDebugger }
+{ =========================================================================== }
 
 constructor TGDBDebugger.Create;
 begin
@@ -123,6 +137,21 @@ begin
   inherited Done;
 end;
 
+function  TGDBDebugger.FindBreakpoint(const ABreakpoint: Integer): TDBGBreakPoint;
+var
+  n: Integer;
+begin                     
+  if  ABreakpoint <> 0 
+  then
+    for n := 0 to Breakpoints.Count - 1 do
+    begin
+      Result := Breakpoints[n];
+      if TGDBBreakpoint(Result).FBreakID = ABreakpoint
+      then Exit;
+    end;
+  Result := nil;
+end;
+
 procedure TGDBDebugger.GDBJumpTo(const ASource: String; const ALine: Integer);
 begin
 end;
@@ -139,7 +168,7 @@ begin
   case State of 
     dsIdle, dsStop: begin
       GDBStart;
-      dState := GetGDBState;
+      dState := GetProgramInfo(False).State;
       if dState = dsPause
       then begin
         RunCommand('cont'); 
@@ -212,7 +241,7 @@ begin
     repeat
       SendCmdLn('cont', True);
       loc := GetLocation;
-      dState := GetGDBState;
+      dState := GetProgramInfo(False).State;
     until (loc.FuncName = 'main') or (Integer(loc.Adress) = StopAdress) or (dState <> dsPause);
   end;
 end;
@@ -222,8 +251,7 @@ begin
   case State of 
     dsIdle, dsStop: begin
       GDBStart;
-      DoCurrent(GetLocation);
+      GetProgramInfo(True);
-      SetState(GetGDBState);
     end;
     dsPause: begin
       RunCommand('step');
@@ -236,8 +264,7 @@ begin
   case State of 
     dsIdle, dsStop: begin
       GDBStart;
-      DoCurrent(GetLocation);
+      GetProgramInfo(True);
-      SetState(GetGDBState);
     end;
     dsPause: begin
       RunCommand('next');
@@ -256,31 +283,18 @@ begin
     SendCmdLn('', True);
   end;
 
-  dState := GetGDBState;
+  dState := GetProgramInfo(False).State;
-  if dState <> dsPause 
+  if dState = dsPause 
-  then Exit;
+  then begin
-
     SendCmdLn('kill', True);
-  dState := GetGDBState;   
+    dState := GetProgramInfo(False).State;   
+  end;
 
   if dState = dsStop
   then KillTargetProcess;
   SetState(dState);
 end;
 
-function TGDBDebugger.GetGDBState: TDBGState;
-var
-  S: String;
-begin
-  SendCmdLn('info program', True);
-  S := OutputLines.Text;
-  if Pos('stopped', S) > 0 
-  then Result := dsPause
-  else if Pos('not being run', S) > 0 
-  then Result := dsStop
-  else Result := dsNone;
-end;
-
 function TGDBDebugger.GetLocation: TDBGLocationRec;
 var              
   n, idx: Integer;
@@ -326,6 +340,64 @@ begin
   end;
 end;
 
+function TGDBDebugger.GetProgramInfo(const AHandleResult: Boolean): TGDBProgramInfo;
+var
+  S, Signal: String;
+  BreakPoint: TGDBBreakPoint;
+begin                     
+  // Loop since we might have hit a non-break breakpoint              
+  while True do  
+  begin
+    Result.Breakpoint := 0;  
+    Result.Signal := 0;
+    Result.SignalText := '';
+    Result.State := dsNone;
+                
+    SendCmdLn('info program', True);
+    S := OutputLines.Text;
+    if Pos('stopped', S) > 0 
+    then begin
+      Result.State := dsPause;
+      if Pos('breakpoint ', S) > 0
+      then begin
+        Result.Breakpoint := StrToIntDef(GetPart('breakpoint ', '.', S), 0);
+      end
+      else if Pos('signal ', S) > 0
+      then begin
+        Signal := GetPart('signal ', ',', S);
+        // TODO: translate to id
+        Result.SignalText := GetPart(' ', '.', S);
+      end;
+    end
+    else if Pos('not being run', S) > 0 
+    then Result.State := dsStop;
+    
+    if AHandleResult
+    then begin
+      if Result.Breakpoint <> 0
+      then begin
+        BreakPoint := TGDBBreakPoint(FindBreakPoint(Result.Breakpoint));
+        if BreakPoint <> nil
+        then begin
+          BreakPoint.Hit;
+          
+          if not (bpaStop in BreakPoint.Actions)
+          then begin
+            SendCmdLn('cont', True);
+            Continue;
+          end;
+        end;
+      end;
+      SetState(Result.State);
+      DoCurrent(GetLocation);
+
+      if Result.SignalText <> ''
+      then DoException(Result.Signal, Result.SignalText);
+    end;
+    Break;
+  end;
+end;
+
 function TGDBDebugger.GetSupportedCommands: TDBGCommands; 
 begin
   Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak{, dcWatch}]
@@ -361,8 +433,7 @@ procedure TGDBDebugger.RunCommand(const ACommand: String);
 begin
   SetState(dsRun);
   SendCmdLn(ACommand, True);
-  DoCurrent(GetLocation);
+  GetProgramInfo(True);
-  SetState(GetGDBState);
 end;
 
 function TGDBDebugger.SendCommand(const ACommand: String; Values: array of const): TStrings;
@@ -376,14 +447,14 @@ begin
   if AValue <> FileName
   then begin
     GDBStop;
-    inherited; 
+    if AValue <> ''
-    if FileName <> ''
     then begin
-      SendCmdLn('file %s', [FileName], True);
+      SendCmdLn('file %s', [AValue], True);
       FHasSymbols := Pos('no debugging symbols', OutputLines.Text) = 0;
       if not FHasSymbols
-      then WriteLN('WARNING: File ''',FileName, ''' has no debug symbols');
+      then WriteLN('WARNING: File ''',AValue, ''' has no debug symbols');
     end;
+    inherited; 
   end;
 end;
 
@@ -392,11 +463,12 @@ procedure TGDBDebugger.TestCmd(const ACommand: String);
 begin
   SetState(dsRun);
   inherited TestCmd(ACommand);
-  DoCurrent(GetLocation);
+  GetProgramInfo(True);
-  SetState(GetGDBState);
 end;
 
+{ =========================================================================== }
 { TGDBBreakPoint }
+{ =========================================================================== }
 
 constructor TGDBBreakPoint.Create(ACollection: TCollection); 
 begin
@@ -431,14 +503,30 @@ procedure TGDBBreakPoint.DoExpressionChange;
 begin
 end;
 
-procedure TGDBBreakPoint.SetLocation(const ASource: String; const ALine: Integer); 
+procedure TGDBBreakPoint.DoStateChange; 
+begin   
+  inherited;
+  if  (Debugger.State = dsStop)
+  and (FBreakID = 0)
+  then SetBreakpoint;
+end;
+
+procedure TGDBBreakPoint.Hit;
+begin
+  SetHitCount(HitCount + 1);
+
+  if bpaEnableGroup in Actions
+  then; //TODO
+  if bpaDisableGroup in Actions
+  then; //TODO
+end;
+  
+procedure TGDBBreakPoint.SetBreakpoint;
 var
   idx: Integer;
   S: String;
 begin
-  if TGDBDebugger(Debugger).State in [dsStop, dsPause, dsIdle]
+  S := TGDBDebugger(Debugger).SendCommand('break %s:%d', [Source, Line])[0];
-  then begin
-    S := TGDBDebugger(Debugger).SendCommand('break %s:%d', [ASource, ALine])[0];
   idx := Pos(' at', S);
   if idx >0 
   then begin
@@ -447,9 +535,18 @@ begin
   SetValid(FBreakID <> 0);
   DoEnableChange;
 end;
+
+  
+procedure TGDBBreakPoint.SetLocation(const ASource: String; const ALine: Integer); 
+begin  
+  inherited;
+  if TGDBDebugger(Debugger).State in [dsStop, dsPause, dsIdle]
+  then SetBreakpoint;
 end;
 
+{ =========================================================================== }
 { TGDBWatch }
+{ =========================================================================== }
 
 procedure TGDBWatch.DoEnableChange; 
 begin
@@ -457,7 +554,7 @@ end;
 
 function TGDBWatch.GetValue: String; 
 begin
-  if (TGDBDebugger(Debugger).State in [dsStop, dsPause, dsIdle])
+  if (Debugger.State in [dsStop, dsPause, dsIdle])
   and Valid 
   then begin
   end
@@ -472,7 +569,7 @@ end;
 procedure TGDBWatch.SetExpression(const AValue: String); 
 begin
   if  (AValue <> Expression)
-  and (TGDBDebugger(Debugger).State in [dsStop, dsPause, dsIdle])
+  and (Debugger.State in [dsStop, dsPause, dsIdle])
   then begin
     //TGDBDebugger(Debugger).SendCmdLn('', True);
   end;
@@ -485,6 +582,14 @@ end;
 end.
 { =============================================================================
   $Log$
+  Revision 1.6  2002/02/20 23:33:24  lazarus
+  MWE:
+    + Published OnClick for TMenuItem
+    + Published PopupMenu property for TEdit and TMemo (Doesn't work yet)
+    * Fixed debugger running twice
+    + Added Debugger output form
+    * Enabled breakpoints
+
   Revision 1.5  2002/02/06 08:58:29  lazarus
   MG: fixed compiler warnings and asking to create non existing files
 

debugger/tdbgoutputform.lfm

@@ -1,16 +1,26 @@
 object DbgOutputForm1: TDbgOutputForm
   CAPTION = 'Debug output'
+  OnClose = FormClose
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   TOP = 10
   LEFT = 10
-  HEIGHT = 150
+  HEIGHT = 200
-  WIDTH = 301
+  WIDTH = 400
   object txtOutput: TMemo
     Left = 8
     Top = 104
     Width = 600
     Height = 150
     Align = alClient
+    PopupMenu = mnuPopup
+  end
+  object mnuPopup: TPopupMenu
+    Left = 400
+    Top = 96
+    object popClear: TMenuItem
+      Caption = '&Clear'
+      OnClick = popClearClick
+    end
   end
 end

ide/main.pp

@@ -38,8 +38,8 @@ uses
   MsgView, NewProjectDlg, IDEComp, AbstractFormEditor, FormEditor,
   CustomFormEditor, ObjectInspector, PropEdits, ControlSelection, UnitEditor,
   CompilerOptions, EditorOptions, EnvironmentOpts, TransferMacros, KeyMapping,
-  ProjectOpts, IDEProcs, Process, UnitInfoDlg, Debugger, DBGBreakpoint,
+  ProjectOpts, IDEProcs, Process, UnitInfoDlg, Debugger, DBGOutputForm,
-  DBGWatch, GDBDebugger, RunParamsOpts, ExtToolDialog, MacroPromptDlg,
+  GDBDebugger, RunParamsOpts, ExtToolDialog, MacroPromptDlg,
   LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg, ColumnDlg, OutputFilter,
   BuildLazDialog, MiscOptions, EditDefineTree, CodeToolsOptions, TypInfo;
 
@@ -126,6 +126,7 @@ type
     itmViewMessage : TMenuItem;
     itmViewwatches : TMenuItem;
     itmViewBreakpoints : TMenuItem;
+    itmViewDebugOutput: TMenuItem;
 
     itmProjectNew: TMenuItem;
     itmProjectOpen: TMenuItem;
@@ -194,6 +195,7 @@ type
     procedure mnuViewMessagesClick(Sender : TObject);
     procedure mnuViewWatchesClick(Sender : TObject);
     procedure mnuViewBreakPointsClick(Sender : TObject);
+    procedure mnuViewDebugOutputClick(Sender : TObject);
     procedure MessageViewDblClick(Sender : TObject);
 
     procedure mnuToggleFormUnitClicked(Sender : TObject);
@@ -295,9 +297,10 @@ type
     
     // Debugger events
     procedure OnDebuggerChangeState(Sender: TObject);
-    procedure OnDebuggerCurrentLine(Sender: TObject; 
+    procedure OnDebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
-       const ALocation: TDBGLocationRec);
+    procedure OnDebuggerWatchChanged(Sender: TObject);
-    Procedure OnDebuggerWatchChanged(Sender : TObject);
+    procedure OnDebuggerOutput(Sender: TObject; const AText: String);
+    procedure OnDebuggerException(Sender: TObject; const AExceptionID: Integer; const AExceptionText: String);
     
     // MessagesView events
     procedure MessagesViewSelectionChanged(sender : TObject);
@@ -325,13 +328,15 @@ type
     FOpenEditorsOnCodeToolChange: boolean;
     FBreakPoints: TDBGBreakPoints; // Points to debugger breakpoints if available
                                    // Else to own objet
+    FDebugOutputDlg: TDBGOutputForm;
     FDebugger: TDebugger;
     FRunProcess: TProcess; // temp solution, will be replaced by dummydebugger
     TheCompiler: TCompiler;
     TheOutputFilter: TOutputFilter;
 
-    Function CreateSeperator : TMenuItem;
+    function CreateSeperator : TMenuItem;
-    Procedure SetDefaultsForForm(aForm : TCustomForm);
+    procedure SetDefaultsForForm(aForm : TCustomForm);
+    procedure OutputFormDestroy(Sender: TObject);
 
   protected
     procedure ToolButtonClick(Sender : TObject);
@@ -1364,6 +1369,13 @@ begin
   itmViewBreakPoints.Shortcut := VK_B or scCtrl or scAlt;
   itmViewBreakPoints.OnClick := @mnuViewBreakPointsClick;
   mnuView.Add(itmViewBreakPoints);
+
+  itmViewDebugOutput := TMenuItem.Create(Self);
+  itmViewDebugOutput.Name:='itmViewDebugOutput';
+  itmViewDebugOutput.Caption := 'Debug output';
+  itmViewDebugOutput.OnClick := @mnuViewDebugOutputClick;
+  mnuView.Add(itmViewDebugOutput);
+
 //--------------
 // Project
 //--------------
@@ -4117,7 +4129,6 @@ begin
       then Exit;
       FDebugger.FileName := ProgramFilename;
       FDebugger.Arguments := ''; //TODO: get arguments
-      FDebugger.Run;
     end;
   else 
     // Temp solution, in futer it will be run by dummy debugger
@@ -4127,7 +4138,6 @@ begin
       FRunProcess.CommandLine := ProgramFilename;
       FRunProcess.Options:= [poUsePipes, poNoConsole];
       FRunProcess.ShowWindow := swoNone;
-      FRunProcess.Execute;
     except
       on e: Exception do 
         MessageDlg(Format('Error initializing program'#13 + 
@@ -4136,6 +4146,9 @@ begin
     end;
   end;   
   
+  if FDebugOutputDlg <> nil
+  then FDebugOutputDlg.Clear;
+  
   Result := mrOK;
   ToolStatus := itDebugger;
 end;
@@ -4309,6 +4322,8 @@ begin
   //MainUnitInfo:=Project.Units[Project.MainUnit];
   FDebugger.OnState:=@OnDebuggerChangeState;
   FDebugger.OnCurrent:=@OnDebuggerCurrentLine;
+  FDebugger.OnDbgOutput := @OnDebuggerOutput;
+  FDebugger.OnException := @OnDebuggerException;
   if FDebugger.State = dsNone 
   then FDebugger.Init;
   
@@ -5760,10 +5775,19 @@ Writeln('DONE showing breakpoints');
 //  CreateLFM(Insertwatch);
 end;
 
-Procedure TMainIDE.OnDebuggerWatchChanged(Sender : TObject);
+procedure TMainIDE.mnuViewDebugOutputClick(Sender : TObject);
 begin
-  Writeln('OnDebuggerWatchChanged');
+  if FDebugOutputDlg = nil
-  //watch changed.
+  then begin
+    FDebugOutputDlg := TDBGOutputForm.Create(Self);
+    FDebugOutputDlg.OnDestroy := @OutputFormDestroy;
+  end;
+  FDebugOutputDlg.Show;  
+end;
+
+procedure TMainIDE.OutputFormDestroy(Sender: TObject);
+begin
+  FDebugOutputDlg := nil;
 end;
 
 //This adds the watch to the TWatches TCollection and to the watches dialog
@@ -5785,8 +5809,27 @@ begin
   Watches_Dlg.AddWatch(NewWatch.Expression+':'+NewWatch.Value);
 end;
 
+procedure TMainIDE.OnDebuggerException(Sender: TObject; const AExceptionID: Integer; const AExceptionText: String);
+begin
+  MessageDlg('Error', 
+    Format('Project %s raised exception class %d with message ''%s''.', [Project.Title, AExceptionID, AExceptionText]), 
+    mtError,[mbOk],0);
+end;
 
-Procedure TMainIDE.OnWatchAdded(Sender : TObject; AnExpression : String);
+procedure TMainIDE.OnDebuggerOutput(Sender: TObject; const AText: String);
+begin
+  if FDebugOutputDlg <> nil
+  then FDebugOutputDlg.AddText(AText);
+end;
+
+
+procedure TMainIDE.OnDebuggerWatchChanged(Sender : TObject);
+begin
+  Writeln('OnDebuggerWatchChanged');
+  //watch changed.
+end;
+
+procedure TMainIDE.OnWatchAdded(Sender : TObject; AnExpression : String);
 Var
   NewWatch : TdbgWatch;
 begin
@@ -5817,13 +5860,16 @@ begin
   SaveSpeedBtn.Enabled := SourceNotebook.GetActiveSE.Modified;
 end;
 
-Procedure TMainIDE.OnSrcNotebookCreateBreakPoint(Sender : TObject;
+procedure TMainIDE.OnSrcNotebookCreateBreakPoint(Sender : TObject; Line : Integer);
-  Line : Integer);
+var
+  NewBreak: TDBGBreakPoint;
 begin
   if SourceNotebook.Notebook = nil then Exit;
 
   Breakpoints_Dlg.AddBreakPoint(TSourceNotebook(sender).GetActiveSe.FileName,Line);
-  FBreakPoints.Add(TSourceNotebook(sender).GetActiveSe.FileName, Line);
+
+  NewBreak := FBreakPoints.Add(TSourceNotebook(sender).GetActiveSe.FileName, Line);
+  NewBreak.Enabled := True;
 end;
 
 Procedure TMainIDE.OnSrcNotebookDeleteBreakPoint(Sender : TObject;
@@ -6002,6 +6048,14 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.227  2002/02/20 23:33:23  lazarus
+  MWE:
+    + Published OnClick for TMenuItem
+    + Published PopupMenu property for TEdit and TMemo (Doesn't work yet)
+    * Fixed debugger running twice
+    + Added Debugger output form
+    * Enabled breakpoints
+
   Revision 1.226  2002/02/20 16:01:43  lazarus
   MG: fixed editor opts general flags
 

lcl/menus.pp

@@ -101,7 +101,6 @@ type
     property Handle: HMenu read GetHandle write FHandle;
     property Items[Index: Integer]: TMenuItem read GetItem; default;
     property Parent: TMenuItem read GetParent;
-    property OnClick: TNotifyEvent read FOnClick write FOnclick; 
   published
     property Caption: String read FCaption write SetCaption {stored IsCaptionStored};
     property Checked: Boolean read FChecked write SetChecked {stored IsCheckedStored} default False;
@@ -111,6 +110,7 @@ type
     property ImageIndex : Integer read FImageIndex write SetImageIndex;
     property ShortCut: TShortCut read FShortCut write SetShortCut {stored IsShortCutStored} default 0;
     property Visible: Boolean read FVisible write SetVisible {stored IsVisibleStored} default True;
+    property OnClick: TNotifyEvent read FOnClick write FOnclick; 
   end;
 
   TFindItemKind = (fkCommand, fkHandle, fkShortCut);
@@ -203,6 +203,14 @@ end.
 
 {
   $Log$
+  Revision 1.7  2002/02/20 23:33:24  lazarus
+  MWE:
+    + Published OnClick for TMenuItem
+    + Published PopupMenu property for TEdit and TMemo (Doesn't work yet)
+    * Fixed debugger running twice
+    + Added Debugger output form
+    * Enabled breakpoints
+
   Revision 1.6  2002/02/18 22:46:11  lazarus
   Implented TMenuItem.ShortCut (not much tested).
 

lcl/stdctrls.pp

@@ -308,6 +308,7 @@ type
       property CharCase;
       property DragMode;
       property MaxLength;
+      property PopupMenu;
       property ReadOnly;
       property Text;
       property Visible;
@@ -321,8 +322,8 @@ type
       property Align;
       property Color;
       property Font;
-
       property Lines;
+      property PopupMenu;
       property ReadOnly;
       property Tabstop;
       property Visible;
@@ -582,6 +583,14 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.21  2002/02/20 23:33:24  lazarus
+  MWE:
+    + Published OnClick for TMenuItem
+    + Published PopupMenu property for TEdit and TMemo (Doesn't work yet)
+    * Fixed debugger running twice
+    + Added Debugger output form
+    * Enabled breakpoints
+
   Revision 1.20  2002/02/03 00:24:01  lazarus
   TPanel implemented.
   Basic graphic primitives split into GraphType package, so that we can