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

MWE:

Browse Source 
+ 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 -
This commit is contained in:
lazarus 2002-02-20 23:33:24 +00:00
parent fc555077c1
commit 721fce0aee
12 changed files with 827 additions and 669 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

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

18
debugger/cmdlinedebugger.pp
View File

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

400
debugger/dbgbreakpoint.pp
View File

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

10
debugger/dbgoutputform.lrc
View File

@ -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
+'LEFT'#2#10#6'HEIGHT'#3#150#0#5'WIDTH'#3'-'#1#0#5'TMemo'#9'txtOutput'#4'L'
+'eft'#2#8#3'Top'#2'h'#5'Width'#3'X'#2#6'Height'#3#150#0#5'Align'#7#8'alCl'
+'ient'#0#0#0
+#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11
+'FormDestroy'#3'TOP'#2#10#4'LEFT'#2#10#6'HEIGHT'#3#200#0#5'WIDTH'#3#144#1
+#0#5'TMemo'#9'txtOutput'#4'Left'#2#8#3'Top'#2'h'#5'Width'#3'X'#2#6'Height'
+#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
);

30
debugger/dbgoutputform.pp
View File

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

171
debugger/dbgwatch.pp
View File

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

543
debugger/debugger.pp
View File

@ -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
@ -112,20 +248,21 @@ type
procedure Stop; // quit debugging
procedure StepOver;
procedure StepInto;
procedure RunTo(const ASource: String; const ALine: Integer); virtual; // Executes til a certain point
procedure JumpTo(const ASource: String; const ALine: Integer); virtual; // No execute, only set exec point
property SupportedCommands: TDBGCommands read GetSupportedCommands; // All available commands of the debugger
property Arguments: String read FArguments write FArguments; // Arguments feed to the program
property BreakPoints: TDBGBreakPoints read FBreakPoints; // list of all breakpoints
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 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 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
procedure RunTo(const ASource: String; const ALine: Integer); virtual; // Executes til a certain point
procedure JumpTo(const ASource: String; const ALine: Integer); virtual; // No execute, only set exec point
property SupportedCommands: TDBGCommands read GetSupportedCommands; // All available commands of the debugger
property Arguments: String read FArguments write FArguments; // Arguments feed to the program
property BreakPoints: TDBGBreakPoints read FBreakPoints; // list of all breakpoints
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 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
end;
implementation
@ -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);
@ -264,11 +408,14 @@ begin
if FFileName <> AValue
then begin
if FState in [dsRun, dsPause]
then Stop;
then Stop;
// Reset state
FFileName := '';
SetState(dsIdle);
FFileName := AValue;
if FFilename = ''
then SetState(dsIdle)
else SetState(dsStop);
if FFilename <> ''
then 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

199
debugger/gdbdebugger.pp
View File

@ -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);
SetState(GetGDBState);
GetProgramInfo(True);
end;
dsPause: begin
RunCommand('step');
@ -236,8 +264,7 @@ begin
case State of
dsIdle, dsStop: begin
GDBStart;
DoCurrent(GetLocation);
SetState(GetGDBState);
GetProgramInfo(True);
end;
dsPause: begin
RunCommand('next');
@ -256,31 +283,18 @@ begin
SendCmdLn('', True);
end;
dState := GetGDBState;
if dState <> dsPause
then Exit;
SendCmdLn('kill', True);
dState := GetGDBState;
dState := GetProgramInfo(False).State;
if dState = dsPause
then begin
SendCmdLn('kill', True);
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);
SetState(GetGDBState);
GetProgramInfo(True);
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 FileName <> ''
if AValue <> ''
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);
SetState(GetGDBState);
GetProgramInfo(True);
end;
{ =========================================================================== }
{ TGDBBreakPoint }
{ =========================================================================== }
constructor TGDBBreakPoint.Create(ACollection: TCollection);
begin
@ -431,25 +503,50 @@ 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];
idx := Pos(' at', S);
if idx >0
then begin
S := TGDBDebugger(Debugger).SendCommand('break %s:%d', [ASource, ALine])[0];
idx := Pos(' at', S);
if idx >0
then begin
FBreakID := StrToIntDef(Copy(S, 12, idx - 12), 0);
end;
SetValid(FBreakID <> 0);
DoEnableChange;
FBreakID := StrToIntDef(Copy(S, 12, idx - 12), 0);
end;
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

14
debugger/tdbgoutputform.lfm
View File

@ -1,16 +1,26 @@
object DbgOutputForm1: TDbgOutputForm
CAPTION = 'Debug output'
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
TOP = 10
LEFT = 10
HEIGHT = 150
WIDTH = 301
HEIGHT = 200
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

88
ide/main.pp
View File

@ -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,
DBGWatch, GDBDebugger, RunParamsOpts, ExtToolDialog, MacroPromptDlg,
ProjectOpts, IDEProcs, Process, UnitInfoDlg, Debugger, DBGOutputForm,
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;
const ALocation: TDBGLocationRec);
Procedure OnDebuggerWatchChanged(Sender : TObject);
procedure OnDebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
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;
Procedure SetDefaultsForForm(aForm : TCustomForm);
function CreateSeperator : TMenuItem;
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 +
@ -4135,7 +4145,10 @@ begin
'Error: %s', [ProgramFilename, e.Message]), mterror, [mbok], 0);
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');
//watch changed.
if FDebugOutputDlg = nil
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;
Line : Integer);
procedure TMainIDE.OnSrcNotebookCreateBreakPoint(Sender : TObject; 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

10
lcl/menus.pp
View File

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

11
lcl/stdctrls.pp
View File

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