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

MWE:

Browse Source 
+ Added locals dialog
  * Modified breakpoints dialog (load as resource)
  + Added generic debuggerdlg class
  = Reorganized main.pp, all debbugger relater routines are moved
    to include/ide_debugger.inc

git-svn-id: trunk@1536 -
This commit is contained in:
lazarus 2002-03-23 15:54:30 +00:00
parent 5e3396a8bf
commit ecd33ba5b5
19 changed files with 1125 additions and 547 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -60,8 +60,10 @@ debugger/breakpointsdlg.pp svneol=native#text/pascal
debugger/cmdlinedebugger.pp svneol=native#text/pascal
debugger/dbgoutputform.pp svneol=native#text/pascal
debugger/debugger.pp svneol=native#text/pascal
debugger/debuggerdlg.pp svneol=native#text/pascal
debugger/gdbdebugger.pp svneol=native#text/pascal
debugger/gdbmidebugger.pp svneol=native#text/pascal
debugger/localsdlg.pp svneol=native#text/pascal
debugger/tbreakpointsdlg.lfm svneol=native#text/plain
debugger/tdbgoutputform.lfm svneol=native#text/plain
debugger/test/debugtest.pp svneol=native#text/pascal
@ -69,6 +71,7 @@ debugger/test/debugtestform.pp svneol=native#text/pascal
debugger/test/examples/testcntr.pp svneol=native#text/pascal
debugger/test/examples/testwait.pp svneol=native#text/pascal
debugger/test/tdebugtesttorm.lfm svneol=native#text/plain
debugger/tlocalsdlg.lfm svneol=native#text/plain
designer/abstractcompiler.pp svneol=native#text/pascal
designer/abstracteditor.pp svneol=native#text/pascal
designer/abstractfilesystem.pp svneol=native#text/pascal
@ -140,6 +143,7 @@ ide/ideoptiondefs.pas svneol=native#text/pascal
ide/ideprocs.pp svneol=native#text/pascal
ide/include/freebsd/lazconf.inc svneol=native#text/pascal
ide/include/ide.inc svneol=native#text/pascal
ide/include/ide_debugger.inc svneol=native#text/pascal
ide/include/linux/lazconf.inc svneol=native#text/pascal
ide/include/netbsd/lazconf.inc svneol=native#text/pascal
ide/include/win32/lazconf.inc svneol=native#text/pascal

25
debugger/breakpointsdlg.lrc
View File

@ -1,10 +1,23 @@
LazarusResources.Add('TBreakpointsDlg','FORMDATA',
'TPF0'#15'TBreakpointsDlg'#14'BreakpointsDlg'#4'Left'#3'T'#1#3'Top'#2'u'#5
+'Width'#3'*'#2#6'Height'#3#200#0#7'Caption'#6#11'Breakpoints'#0#9'TListVi'
+'ew'#9'ListView1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3'"'#2#6'Height'#3#171#0
+#5'Align'#7#8'alClient'#7'Columns'#14#1#7'Caption'#6#16'Filename/Address'
+#5'Width'#3#150#0#0#1#7'Caption'#6#11'Line/Length'#5'Width'#2'd'#0#1#7'Ca'
+'ption'#6#9'Condition'#5'Width'#2'K'#0#1#7'Caption'#6#6'Action'#0#1#7'Cap'
+'tion'#6#10'Pass Count'#5'Width'#2'd'#0#1#7'Caption'#6#5'Group'#0#0#11'Mu'
+'ltiSelect'#9#9'ViewStyle'#7#8'vsReport'#0#0#0
+'ew'#13'lvBreakPoints'#4'Left'#2#0#3'Top'#2#0#5'Width'#3'"'#2#6'Height'#3
+#171#0#5'Align'#7#8'alClient'#7'Columns'#14#1#7'Caption'#6#5'State'#5'Wid'
+'th'#2'2'#0#1#7'Caption'#6#16'Filename/Address'#5'Width'#3#150#0#0#1#7'Ca'
+'ption'#6#11'Line/Length'#5'Width'#2'd'#0#1#7'Caption'#6#9'Condition'#5'W'
+'idth'#2'K'#0#1#7'Caption'#6#6'Action'#5'Width'#2'2'#0#1#7'Caption'#6#10
+'Pass Count'#5'Width'#2'd'#0#1#7'Caption'#6#5'Group'#0#0#11'MultiSelect'#9
+#9'PopupMenu'#7#8'mnuPopup'#9'ViewStyle'#7#8'vsReport'#0#0#10'TPopupMenu'
+#8'mnuPopup'#4'Left'#2'd'#3'Top'#2'`'#0#9'TMenuItem'#6'popAdd'#7'Caption'
+#6#6'Add...'#0#9'TMenuItem'#14'popAddSourceBP'#7'Caption'#6#18'&Source br'
+'eakpoint'#7'OnClick'#7#19'popAddSourceBPClick'#0#0#0#9'TMenuItem'#12'pop'
+'DeleteAll'#7'Caption'#6#11'&Delete All'#7'OnClick'#7#17'popDeleteAllClic'
+'k'#0#0#9'TMenuItem'#13'popDisableAll'#7'Caption'#6#12'D&isable All'#7'On'
+'Click'#7#18'popDisableAllClick'#0#0#9'TMenuItem'#12'popEnableAll'#7'Capt'
+'ion'#6#11'&Enable All'#7'OnClick'#7#17'popEnableAllClick'#0#0#0#10'TPopu'
+'pMenu'#14'mnuPopSelected'#4'Left'#3#150#0#3'Top'#2'`'#0#9'TMenuItem'#10
+'popEnabled'#7'Caption'#6#8'&Enabled'#7'OnClick'#7#15'popEnabledClick'#0#0
+#9'TMenuItem'#9'popDelete'#7'Caption'#6#7'&Delete'#7'OnClick'#7#14'popDel'
+'eteClick'#0#0#9'TMenuItem'#13'popProperties'#7'Caption'#6#11'&Properties'
+#7'OnClick'#7#18'popPropertiesClick'#0#0#0#0
);

307
debugger/breakpointsdlg.pp
View File

@ -1,131 +1,242 @@
unit breakpointsdlg;
{ $Id$ }
{ ----------------------------------------------
breakpointsdlg.pp - Overview of breeakponts
----------------------------------------------
{ ----------------------------------------------
breakpointsdlg.pp - Overview of breeakponts
----------------------------------------------
@created(Fri Dec 14st WET 2001)
@lastmod($Date$)
@author(Shane Miller)
@author(Marc Weustink <marc@@dommelstein.net>)
@author(Shane Miller)
@author(Marc Weustink <marc@@dommelstein.net>)
This unit contains the Breakpoint dialog.
/***************************************************************************
* *
* 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. *
* *
***************************************************************************/
}
/***************************************************************************
* *
* 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 breakpointsdlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls,Buttons,Extctrls,ComCtrls;
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls,
Buttons, Extctrls, Menus, ComCtrls, Debugger, DebuggerDlg;
type
TBreakPointsDlg = class(TForm)
TBreakPointsDlg = class(TDebuggerDlg)
lvBreakPoints: TListView;
procedure lvBreakPointsClick(Sender: TObject);
mnuPopup: TPopupMenu;
popAdd: TMenuItem;
popAddSourceBP: TMenuItem;
procedure popAddSourceBPClick(Sender: TObject);
popDeleteAll: TMenuItem;
procedure popDeleteAllClick(Sender: TObject);
popDisableAll: TMenuItem;
procedure popDisableAllClick(Sender: TObject);
popEnableAll: TMenuItem;
procedure popEnableAllClick(Sender: TObject);
mnuPopSelected: TPopupMenu;
popEnabled: TMenuItem;
procedure popEnabledClick(Sender: TObject);
popDelete: TMenuItem;
procedure popDeleteClick(Sender: TObject);
popProperties: TMenuItem;
procedure popPropertiesClick(Sender: TObject);
private
procedure AddBreakPoint(UnitName : String; Line : Integer);
procedure DeleteBreakPoint(UnitName : String; Line : Integer);
procedure BreakPointAdd(const ASender: TDBGBreakPoints; const ABreakpoint: TDBGBreakPoint);
procedure BreakPointUpdate(const ASender: TDBGBreakPoints; const ABreakpoint: TDBGBreakPoint);
procedure BreakPointRemove(const ASender: TDBGBreakPoints; const ABreakpoint: TDBGBreakPoint);
procedure UpdateItem(const AItem: TListItem; const ABreakpoint: TDBGBreakPoint);
protected
procedure Loaded; override;
procedure SetDebugger(const ADebugger: TDebugger); override;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
end;
var
BREAKPOINTS_DLG: TBreakPointsDlg;
published
property Dummy: Boolean; // insert some dummies until fpcbug #1888 is fixed
end;
implementation
constructor TBreakPointsdlg.Create(AOwner : TComponent);
procedure TBreakPointsDlg.BreakPointAdd(const ASender: TDBGBreakPoints; const ABreakpoint: TDBGBreakPoint);
var
Item: TListItem;
n: Integer;
begin
inherited;
(*
if LazarusResources.Find(Classname)=nil then
begin
lvBreakPoints := TListView.Create(self);
with lvBreakPoints do
Begin
Parent := self;
Align := alClient;
Visible := True;
Name := 'lvBreakPoints';
Columns.Clear;
Columns.Updating := TRue;
Columns.Add('Filename/Address');
Columns.Add('Line/Length');
Columns.Add('Condition');
Columns.Add('Action');
Columns.Add('Pass Count');
Columns.Add('Group');
Columns.Updating := False;
//Example alignment of columns.
// Columns.Item[1].Alignment := caRight;
ViewStyle := vsReport;
Sorted := True;
OnKeyDown := @lvBreakPointsKeyDown;
MultiSelect := True;
end;
//ListView does not accpet keys unless the mouse is held down over it
//so temporarily I do this:
OnKeyDown := @lvBreakPointsKeyDown;
Caption := 'Breakpoints';
Name := 'BreakPointsDlg';
Width := 350;
Height := 100;
Item := lvBreakPoints.Items.FindData(ABreakpoint);
if Item = nil
then begin
Item := lvBreakPoints.Items.Add;
Item.Data := ABreakPoint;
for n := 0 to 5 do
Item.SubItems.Add('');
end;
*)
UpdateItem(Item, ABreakPoint);
end;
destructor TBreakPointsDlg.Destroy;
begin
inherited;
end;
procedure TBreakPointsDlg.AddBreakPoint(UnitName : String; Line : Integer);
procedure TBreakPointsDlg.BreakPointUpdate(const ASender: TDBGBreakPoints; const ABreakpoint: TDBGBreakPoint);
var
LI : TListItem;
Item: TListItem;
begin
LI := lvBreakPoints.Items.Add;
LI.Caption := UnitName;
LI.SubItems.Add(Inttostr(line));
LI.SubItems.Add('');
LI.SubItems.Add('Break');
LI.SubItems.Add('0');
LI.SubItems.Add('');
if ABreakpoint = nil then Exit;
Item := lvBreakPoints.Items.FindData(ABreakpoint);
if Item = nil
then BreakPointAdd(ASender, ABreakPoint)
else UpdateItem(Item, ABreakPoint);
end;
procedure TBreakPointsDlg.BreakPointRemove(const ASender: TDBGBreakPoints; const ABreakpoint: TDBGBreakPoint);
begin
lvBreakPoints.Items.FindData(ABreakpoint).Free;
end;
procedure TBreakPointsDlg.DeleteBreakPoint(UnitName : String; Line : Integer);
procedure TBreakPointsDlg.Loaded;
begin
inherited Loaded;
// Not yet through resources
mnuPopUp.Items.Add(popAdd);
popAdd.Add(popAddSourceBP);
mnuPopUp.Items.Add(popDeleteAll);
mnuPopUp.Items.Add(popDisableAll);
mnuPopUp.Items.Add(popEnableAll);
mnuPopSelected.Items.Add(popEnabled);
mnuPopSelected.Items.Add(popDelete);
mnuPopSelected.Items.Add(popProperties);
end;
procedure TBreakPointsDlg.lvBreakPointsClick(Sender: TObject);
var
LI : TListItem;
I : Integer;
Item: TListItem;
begin
for I := 0 to lvBreakPoints.Items.Count-1 do
Begin
LI := lvBreakPoints.Items[i];
if LI.Caption <> UnitName then Continue;
if LI.SubItems.Strings[0] = inttostr(line) then
begin
lvBreakPoints.Items.Delete(i);
Break;
end;
end;
Item := lvBreakPoints.Selected;
if Item = nil
then lvBreakPoints.PopupMenu := mnuPopup
else lvBreakPoints.PopupMenu := mnuPopSelected;
end;
procedure TBreakPointsDlg.popAddSourceBPClick(Sender: TObject);
begin
end;
procedure TBreakPointsDlg.popDeleteAllClick(Sender: TObject);
var
n: Integer;
begin
for n := lvBreakPoints.Items.Count - 1 downto 0 do
TDBGBreakPoint(lvBreakPoints.Items[n].Data).Free;
end;
procedure TBreakPointsDlg.popDeleteClick(Sender: TObject);
begin
end;
procedure TBreakPointsDlg.popDisableAllClick(Sender: TObject);
var
n: Integer;
Item: TListItem;
begin
for n := 0 to lvBreakPoints.Items.Count - 1 do
begin
Item := lvBreakPoints.Items[n];
if Item.Data <> nil
then TDBGBreakPoint(Item.Data).Enabled := False;
end;
end;
procedure TBreakPointsDlg.popEnableAllClick(Sender: TObject);
var
n: Integer;
Item: TListItem;
begin
for n := 0 to lvBreakPoints.Items.Count - 1 do
begin
Item := lvBreakPoints.Items[n];
if Item.Data <> nil
then TDBGBreakPoint(Item.Data).Enabled := True;
end;
end;
procedure TBreakPointsDlg.popEnabledClick(Sender: TObject);
begin
end;
procedure TBreakPointsDlg.popPropertiesClick(Sender: TObject);
begin
end;
procedure TBreakPointsDlg.SetDebugger(const ADebugger: TDebugger);
begin
if ADebugger <> Debugger
then begin
if Debugger <> nil
then begin
Debugger.Breakpoints.OnAdd := nil;
Debugger.Breakpoints.OnUpdate := nil;
Debugger.Breakpoints.OnRemove := nil;
end;
inherited;
if Debugger <> nil
then begin
Debugger.Breakpoints.OnAdd := @BreakPointAdd;
Debugger.Breakpoints.OnUpdate := @BreakPointUpdate;
Debugger.Breakpoints.OnRemove := @BreakPointRemove;
end;
end
else inherited;
end;
procedure TBreakPointsDlg.UpdateItem(const AItem: TListItem; const ABreakpoint: TDBGBreakPoint);
const
DEBUG_ACTION: array[TDBGBreakPointAction] of string = ('Break', 'Enable Group', 'Disable Group');
// enabled valid
DEBUG_STATE: array[Boolean, Boolean] of String = (('?', ''), ('!', '*'));
var
Action: TDBGBreakPointAction;
S: String;
begin
// Filename/Address
// Line/Length
// Condition
// Action
// Pass Count
// Group
AItem.Caption := DEBUG_STATE[ABreakpoint.Enabled, ABreakpoint.Valid];
AItem.SubItems[0] := ABreakpoint.Source;
if ABreakpoint.Line > 0
then AItem.SubItems[1] := IntToStr(ABreakpoint.Line)
else AItem.SubItems[1] := '';
AItem.SubItems[2] := ABreakpoint.Expression;
S := '';
for Action := Low(Action) to High(Action) do
if Action in ABreakpoint.Actions
then begin
if S <> '' then s := S + ', ';
S := S + DEBUG_ACTION[Action]
end;
AItem.SubItems[3] := S;
AItem.SubItems[4] := IntToStr(ABreakpoint.HitCount);
if ABreakpoint.Group = nil
then AItem.SubItems[5] := ''
else AItem.SubItems[5] := ABreakpoint.Group.Name;
end;
initialization
{$I breakpointsdlg.lrc}
@ -133,6 +244,14 @@ end.
{ =============================================================================
$Log$
Revision 1.2 2002/03/23 15:54:30 lazarus
MWE:
+ Added locals dialog
* Modified breakpoints dialog (load as resource)
+ Added generic debuggerdlg class
= Reorganized main.pp, all debbugger relater routines are moved
to include/ide_debugger.inc
Revision 1.1 2002/03/12 23:55:36 lazarus
MWE:
* More delphi compatibility added/updated to TListView

41
debugger/cmdlinedebugger.pp
View File

@ -39,9 +39,10 @@ type
FOutputBuf: String;
FReading: Boolean; // Set if we are in the ReadLine loop
FFlushAfterRead: Boolean;// Set if we should flus if we finished reading
FPeekOffset: Integer; // Counst the number of lines we have peeked
function GetDebugProcessRunning: Boolean;
protected
function CreateDebugProcess(const AName: String): Boolean;
function CreateDebugProcess(const AOptions: String): Boolean;
procedure Flush; // Flushes output buffer
// procedure KillTargetProcess;
function ReadLine: String; overload;
@ -52,7 +53,7 @@ type
property DebugProcessRunning: Boolean read GetDebugProcessRunning;
property LineEnds: TStringList read FLineEnds;
public
constructor Create; {override; }
constructor Create(const AExternalDebugger: String); {override; }
destructor Destroy; override;
procedure TestCmd(const ACommand: String); virtual;// For internal debugging purposes
end;
@ -223,22 +224,23 @@ end;
{ TCmdLineDebugger }
constructor TCmdLineDebugger.Create;
constructor TCmdLineDebugger.Create(const AExternalDebugger: String);
begin
FDbgProcess := nil;
FLineEnds := TStringList.Create;
FLineEnds.Add(LINE_END);
FReading := False;
FFlushAfterRead := False;
inherited Create;
FPeekOffset := 0;
inherited;
end;
function TCmdLineDebugger.CreateDebugProcess(const AName:String): Boolean;
function TCmdLineDebugger.CreateDebugProcess(const AOptions: String): Boolean;
begin
if FDbgProcess = nil
then begin
FDbgProcess := TProcess.Create(nil);
FDbgProcess.CommandLine := AName;
FDbgProcess.CommandLine := ExternalDebugger + ' ' + AOptions;
FDbgProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutPut];
FDbgProcess.ShowWindow := swoNone;
end;
@ -325,13 +327,16 @@ function TCmdLineDebugger.ReadLine(const APeek: Boolean): String;
var
WaitSet: Integer;
LineEndMatch: String;
n, Idx, MinIdx: Integer;
n, Idx, MinIdx, PeekCount: Integer;
begin
// WriteLN('[TCmdLineDebugger.GetOutput] Enter');
// TODO: get extra handles to wait for
// TODO: Fix multiple peeks
if not APeek
then FPeekOffset := 0;
FReading := True;
PeekCount := 0;
repeat
if FOutputBuf <> ''
then begin
@ -348,8 +353,16 @@ begin
then begin
n := MinIdx + Length(LineEndMatch) - 1;
Result := Copy(FOutputBuf, 1, n);
if not APeek
then Delete(FOutputBuf, 1, n);
if APeek
then begin
if PeekCount = FPeekOffset
then Inc(FPeekOffset)
else begin
Inc(PeekCount);
Continue;
end;
end
else Delete(FOutputBuf, 1, n);
DoDbgOutput(Result);
Break;
@ -414,6 +427,14 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.8 2002/03/23 15:54:30 lazarus
MWE:
+ Added locals dialog
* Modified breakpoints dialog (load as resource)
+ Added generic debuggerdlg class
= Reorganized main.pp, all debbugger relater routines are moved
to include/ide_debugger.inc
Revision 1.7 2002/03/09 02:03:58 lazarus
MWE:
* Upgraded gdb debugger to gdb/mi debugger

12
debugger/dbgoutputform.lrc
View File

@ -1,9 +1,9 @@
LazarusResources.Add('TDbgOutputForm','FORMDATA',
'TPF0'#14'TDbgOutputForm'#14'DbgOutputForm1'#7'CAPTION'#6#12'Debug output'
+#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11
+'FormDestroy'#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'alC'
+'lient'#9'PopupMenu'#7#8'mnuPopup'#0#0#10'TPopupMenu'#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
+#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#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'mnuPopu'
+'p'#0#0#10'TPopupMenu'#8'mnuPopup'#4'Left'#3#144#1#3'Top'#2'`'#0#9'TMenuI'
+'tem'#8'popClear'#7'Caption'#6#6'&Clear'#7'OnClick'#7#13'popClearClick'#0
+#0#0#0
);

23
debugger/dbgoutputform.pp
View File

@ -25,16 +25,15 @@ interface
uses
Classes, Graphics, Controls, Forms, Dialogs, LResources,
Buttons, StdCtrls, Menus;
Buttons, StdCtrls, Menus, DebuggerDlg;
type
TDbgOutputForm = class(TForm)
TDbgOutputForm = class(TDebuggerDlg)
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
@ -42,6 +41,8 @@ type
public
procedure AddText(const AText: String);
procedure Clear;
published
// property Dummy: Boolean; // insert some dummies until fpcbug #1888 is fixed
end;
implementation
@ -66,10 +67,6 @@ begin
txtOutput.Lines.Clear;
end;
procedure TDbgOutputForm.FormDestroy(Sender: TObject);
begin
end;
procedure TDbgOutputForm.Loaded;
begin
inherited Loaded;
@ -79,10 +76,6 @@ begin
// Not yet through resources
mnuPopUp.Items.Add(popClear);
// popClear.Caption := '&Clear';
// popClear.OnClick := @popClearClick;
WriteLn('Popupcount: ', mnuPopUp.Items.Count);
WriteLn('Itemvisible ', popClear.Visible);
end;
procedure TDbgOutputForm.popClearClick(Sender: TObject);
@ -96,6 +89,14 @@ initialization
end.
{ =============================================================================
$Log$
Revision 1.4 2002/03/23 15:54:30 lazarus
MWE:
+ Added locals dialog
* Modified breakpoints dialog (load as resource)
+ Added generic debuggerdlg class
= Reorganized main.pp, all debbugger relater routines are moved
to include/ide_debugger.inc
Revision 1.3 2002/03/09 02:03:59 lazarus
MWE:
* Upgraded gdb debugger to gdb/mi debugger

32
debugger/debugger.pp
View File

@ -224,7 +224,9 @@ type
TDBGLocals = class(TObject)
private
FDebugger: TDebugger; // reference to our debugger
FOnChange: TNotifyEvent;
protected
procedure DoChange;
procedure DoStateChange; virtual;
function GetName(const AnIndex: Integer): String; virtual;
function GetValue(const AnIndex: Integer): String; virtual;
@ -234,6 +236,7 @@ type
constructor Create(const ADebugger: TDebugger);
property Names[const AnIndex: Integer]: String read GetName;
property Values[const AnIndex: Integer]: String read GetValue;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TDBGOutputEvent = procedure(Sender: TObject; const AText: String) of object;
@ -246,6 +249,7 @@ type
FBreakPoints: TDBGBreakPoints;
FBreakPointGroups: TDBGBreakPointGroups;
FExitCode: Integer;
FExternalDebugger: String;
FFileName: String;
FLocals: TDBGLocals;
FState: TDBGState;
@ -274,7 +278,7 @@ type
procedure SetExitCode(const AValue: Integer);
procedure SetState(const AValue: TDBGState);
public
constructor Create; {virtual; Virtual constructor makes no sense}
constructor Create(const AExternalDebugger: String); {virtual; Virtual constructor makes no sense}
//MWE: there will be a day that they do make sense :-)
destructor Destroy; override;
@ -293,6 +297,7 @@ type
property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpointgroups
property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger
property ExitCode: Integer read FExitCode;
property ExternalDebugger: String read FExternalDebugger;
property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged
property Locals: TDBGLocals read FLocals;
property State: TDBGState read FState; // The current state of the debugger
@ -302,8 +307,8 @@ type
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;
end;
implementation
uses
@ -316,7 +321,7 @@ const
{dsStop } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch],
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch, dcLocal],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch],
{dsError} []
{dsError} [dcStop]
);
{ =========================================================================== }
@ -328,7 +333,7 @@ begin
Result := True;
end;
constructor TDebugger.Create;
constructor TDebugger.Create(const AExternalDebugger: String);
begin
inherited Create;
FOnState := nil;
@ -338,6 +343,7 @@ begin
FState := dsNone;
FArguments := '';
FFilename := '';
FExternalDebugger := AExternalDebugger;
FBreakPoints := CreateBreakPoints;
FLocals := CreateLocals;
FWatches := CreateWatches;
@ -649,6 +655,7 @@ begin
then begin
FActions := AValue;
DoActionChange;
Changed(False);
end;
end;
@ -658,6 +665,7 @@ begin
then begin
FEnabled := AValue;
DoEnableChange;
Changed(False);
end;
end;
@ -667,6 +675,7 @@ begin
then begin
FExpression := AValue;
DoExpressionChange;
Changed(False);
end;
end;
@ -974,6 +983,11 @@ begin
FDebugger := ADebugger;
end;
procedure TDBGLocals.DoChange;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TDBGLocals.DoStateChange;
begin
end;
@ -991,6 +1005,14 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.11 2002/03/23 15:54:30 lazarus
MWE:
+ Added locals dialog
* Modified breakpoints dialog (load as resource)
+ Added generic debuggerdlg class
= Reorganized main.pp, all debbugger relater routines are moved
to include/ide_debugger.inc
Revision 1.10 2002/03/12 23:55:36 lazarus
MWE:
* More delphi compatibility added/updated to TListView

73
debugger/debuggerdlg.pp Normal file
View File

@ -0,0 +1,73 @@
{ $Id$ }
{ ----------------------------------------
DebuggerDlg.pp - Base class for all
debugger related forms
----------------------------------------
@created(Wed Mar 16st WET 2001)
@lastmod($Date$)
@author(Marc Weustink <marc@@dommelstein.net>)
This unit contains the base class for all debugger related dialogs.
All common info needed for the IDE is found in this class
/***************************************************************************
* *
* 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 DebuggerDlg;
{$mode objfpc}{$H+}
interface
uses
Forms, Debugger;
type
TDebuggerDlgClass = class of TDebuggerDlg;
TDebuggerDlg = class(TForm)
private
FDebugger: TDebugger;
protected
procedure SetDebugger(const ADebugger: TDebugger); virtual;
public
destructor Destroy; override;
property Debugger: TDebugger read FDebugger write SetDebugger;
end;
implementation
{ TDebuggerDlg }
destructor TDebuggerDlg.Destroy;
begin
Debugger := nil;
inherited;
end;
procedure TDebuggerDlg.SetDebugger(const ADebugger: TDebugger);
begin
FDebugger := ADebugger;
end;
{ =============================================================================
$Log$
Revision 1.1 2002/03/23 15:54:30 lazarus
MWE:
+ Added locals dialog
* Modified breakpoints dialog (load as resource)
+ Added generic debuggerdlg class
= Reorganized main.pp, all debbugger relater routines are moved
to include/ide_debugger.inc
}
end.

57
debugger/gdbmidebugger.pp
View File

@ -70,7 +70,7 @@ type
function GetSupportedCommands: TDBGCommands; override;
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
public
constructor Create; {override;}
constructor Create(const AExternalDebugger: String); {override;}
destructor Destroy; override;
procedure Init; override; // Initializes external debugger
@ -210,16 +210,13 @@ function TGDBMIDebugger.ChangeFileName: Boolean;
var
S: String;
begin
SendCmdLn('-file-exec-and-symbols %s', [FileName]);
S := ReadLine(True);
FHasSymbols := Pos('no debugging symbols', S) = 0;
if not FHasSymbols
then WriteLN('WARNING: File ''',FileName, ''' has no debug symbols');
Result := ProcessResult(True, S) and inherited ChangeFileName;
if Result
FHasSymbols := True; // True untilproven otherwise
Result := ExecuteCommand('-file-exec-and-symbols %s', [FileName]) and inherited ChangeFileName;
if Result and FHasSymbols
then begin
ExecuteCommand('-gdb-set extention-language .lpr pascal');
if not FHasSymbols then Exit; // file-exec-and-symbols not allways result in no symbols
ExecuteCommand('-gdb-set extention-language .lrc pascal');
ExecuteCommand('-gdb-set extention-language .dpr pascal');
ExecuteCommand('-gdb-set extention-language .pas pascal');
@ -228,11 +225,11 @@ begin
end;
end;
constructor TGDBMIDebugger.Create;
constructor TGDBMIDebugger.Create(const AExternalDebugger: String);
begin
FCommandQueue := TStringList.Create;
FTargetPID := 0;
inherited Create;
inherited;
end;
function TGDBMIDebugger.CreateBreakPoints: TDBGBreakPoints;
@ -330,7 +327,7 @@ end;
procedure TGDBMIDebugger.GDBRun;
begin
case State of
dsIdle, dsStop: begin
dsStop: begin
GDBStart;
if State = dsPause
then begin
@ -343,6 +340,9 @@ begin
dsPause: begin
ExecuteCommand('-exec-continue');
end;
dsIdle: begin
WriteLN('[WARNING] Debugger: Unable to run in idle state');
end;
end;
end;
@ -357,10 +357,12 @@ procedure TGDBMIDebugger.GDBStart;
var
S: String;
begin
if State in [dsIdle, dsStop]
if State in [dsStop]
then begin
if FHasSymbols
then begin
then begin
if Arguments <>''
then ExecuteCommand('-exec-arguments %s', [Arguments]);
ExecuteCommand('-break-insert -t main');
ExecuteCommand('-exec-run');
@ -420,7 +422,7 @@ end;
procedure TGDBMIDebugger.Init;
begin
if CreateDebugProcess('/usr/bin/gdb -silent -i mi')
if CreateDebugProcess('-silent -i mi')
then begin
ReadLine; //flush first line
ExecuteCommand('-gdb-set confirm off');
@ -472,7 +474,15 @@ begin
else WriteLN('[WARNING] Debugger: Unknown result class: ', S);
end;
'~': begin // console-stream-output
WriteLN('[Debugger] Console output: ', S);
// check for symbol info
if Pos('no debugging symbols', S) > 0
then begin
FHasSymbols := False;
WriteLN('WARNING: File ''',FileName, ''' has no debug symbols');
end
else begin
WriteLN('[Debugger] Console output: ', S);
end;
end;
'@': begin // target-stream-output
WriteLN('[Debugger] Target output: ', S);
@ -799,8 +809,11 @@ end;
procedure TGDBMILocals.DoStateChange;
begin
if Debugger.State <> dsPause
then begin
if Debugger.State = dsPause
then begin
DoChange;
end
else begin
FLocalsValid := False;
FLocals.Clear;
end;
@ -880,6 +893,14 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.3 2002/03/23 15:54:30 lazarus
MWE:
+ Added locals dialog
* Modified breakpoints dialog (load as resource)
+ Added generic debuggerdlg class
= Reorganized main.pp, all debbugger relater routines are moved
to include/ide_debugger.inc
Revision 1.2 2002/03/12 23:55:36 lazarus
MWE:
* More delphi compatibility added/updated to TListView

8
debugger/localsdlg.lrc Normal file
View File

@ -0,0 +1,8 @@
LazarusResources.Add('TLocalsDlg','FORMDATA',
'TPF0'#10'TLocalsDlg'#9'LocalsDlg'#4'Left'#3'g'#1#3'Top'#2'~'#5'Width'#3'<'
+#2#6'Height'#3#12#1#7'Caption'#6#6'Locals'#0#9'TListView'#8'lvLocals'#4'L'
+'eft'#2#0#3'Top'#2#0#5'Width'#3'4'#2#6'Height'#3#239#0#5'Align'#7#8'alCli'
+'ent'#7'Columns'#14#1#7'Caption'#6#4'Name'#5'Width'#3#150#0#0#1#7'Caption'
+#6#5'Value'#5'Width'#3#144#1#0#0#11'MultiSelect'#9#9'ViewStyle'#7#8'vsRep'
+'ort'#0#0#0
);

125
debugger/localsdlg.pp Normal file
View File

@ -0,0 +1,125 @@
{ $Id$ }
{ ----------------------------------------------
localsdlg.pp - Overview of local variables
----------------------------------------------
@created(Thu Mar 14st WET 2002)
@lastmod($Date$)
@author(Marc Weustink <marc@@dommelstein.net>)
This unit contains the Locals debugger dialog.
/***************************************************************************
* *
* 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 localsdlg;
{$mode objfpc}{$H+}
interface
uses
LResources, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Debugger, DebuggerDlg;
type
TLocalsDlg = class(TDebuggerDlg)
lvLocals: TListView;
private
procedure LocalsChanged(Sender: TObject);
protected
procedure SetDebugger(const ADebugger: TDebugger); override;
public
published
property Dummy: Boolean; // insert some dummies until fpcbug #1888 is fixed
end;
implementation
{ TLocalsDlg }
procedure TLocalsDlg.LocalsChanged(Sender: TObject);
var
n, idx: Integer;
List: TStringList;
Item: TListItem;
S: String;
begin
List := TStringList.Create;
//Get existing items
for n := 0 to lvLocals.Items.Count - 1 do
begin
Item := lvLocals.Items[n];
S := Item.Caption;
S := UpperCase(S);
List.AddObject(S, Item);
end;
// add/update entries
for n := 0 to Debugger.Locals.Count - 1 do
begin
idx := List.IndexOf(Uppercase(Debugger.Locals.Names[n]));
if idx = -1
then begin
// New entry
Item := lvLocals.Items.Add;
Item.Caption := Debugger.Locals.Names[n];
Item.SubItems.Add(Debugger.Locals.Values[n]);
end
else begin
// Existing entry
Item := TListItem(List.Objects[idx]);
Item.SubItems[0] := Debugger.Locals.Values[n];
List.Delete(idx);
end;
end;
// remove obsolete entries
for n := 0 to List.Count - 1 do
lvLocals.Items.Delete(TListItem(List.Objects[n]).Index);
List.Free;
end;
procedure TLocalsDlg.SetDebugger(const ADebugger: TDebugger);
begin
if ADebugger <> Debugger
then begin
if Debugger <> nil
then begin
Debugger.Locals.OnChange := nil;
end;
inherited;
if Debugger <> nil
then begin
Debugger.Locals.OnChange := @LocalsChanged;
LocalsChanged(Debugger.Locals);
end;
end
else inherited;
end;
initialization
{$I localsdlg.lrc}
end.
{ =============================================================================
$Log$
Revision 1.1 2002/03/23 15:54:30 lazarus
MWE:
+ Added locals dialog
* Modified breakpoints dialog (load as resource)
+ Added generic debuggerdlg class
= Reorganized main.pp, all debbugger relater routines are moved
to include/ide_debugger.inc
}

47
debugger/tbreakpointsdlg.lfm
View File

@ -4,13 +4,17 @@ object BreakpointsDlg: TBreakpointsDlg
Width = 554
Height = 200
Caption = 'Breakpoints'
object ListView1: TListView
object lvBreakPoints: TListView
Left = 0
Top = 0
Width = 546
Height = 171
Align = alClient
Columns = <
item
Caption = 'State'
Width = 50
end
item
Caption = 'Filename/Address'
Width = 150
@ -25,6 +29,7 @@ object BreakpointsDlg: TBreakpointsDlg
end
item
Caption = 'Action'
Width = 50
end
item
Caption = 'Pass Count'
@ -34,6 +39,46 @@ object BreakpointsDlg: TBreakpointsDlg
Caption = 'Group'
end>
MultiSelect = True
PopupMenu = mnuPopup
ViewStyle = vsReport
end
object mnuPopup: TPopupMenu
Left = 100
Top = 96
object popAdd: TMenuItem
Caption = 'Add...'
object popAddSourceBP: TMenuItem
Caption = '&Source breakpoint'
OnClick = popAddSourceBPClick
end
end
object popDeleteAll: TMenuItem
Caption = '&Delete All'
OnClick = popDeleteAllClick
end
object popDisableAll: TMenuItem
Caption = 'D&isable All'
OnClick = popDisableAllClick
end
object popEnableAll: TMenuItem
Caption = '&Enable All'
OnClick = popEnableAllClick
end
end
object mnuPopSelected: TPopupMenu
Left = 150
Top = 96
object popEnabled: TMenuItem
Caption = '&Enabled'
OnClick = popEnabledClick
end
object popDelete: TMenuItem
Caption = '&Delete'
OnClick = popDeleteClick
end
object popProperties: TMenuItem
Caption = '&Properties'
OnClick = popPropertiesClick
end
end
end

1
debugger/tdbgoutputform.lfm
View File

@ -2,7 +2,6 @@ object DbgOutputForm1: TDbgOutputForm
CAPTION = 'Debug output'
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
HEIGHT = 200
WIDTH = 400
object txtOutput: TMemo

2
debugger/test/debugtest.pp
View File

@ -5,7 +5,7 @@ program debugtest;
uses
Classes, Forms, DebugTestForm, BreakpointsDlg;
Classes, Forms, DebugTestForm, BreakpointsDlg, LocalsDlg;
begin
Application.Initialize;

29
debugger/test/debugtestform.pp
View File

@ -25,7 +25,7 @@ interface
uses
Classes, Graphics, Controls, Forms, Dialogs, LResources,
Buttons, StdCtrls, Debugger, DbgOutputForm, BreakpointsDlg;
Buttons, StdCtrls, Debugger, DbgOutputForm, BreakpointsDlg, LocalsDlg;
type
@ -71,6 +71,8 @@ type
FDebugger: TDebugger;
FOutputForm: TDBGOutputForm;
FBreakpointDlg: TBreakpointsDlg;
FLocalsDlg: TLocalsDlg;
FDummy: Boolean;
procedure DBGState(Sender: TObject);
procedure DBGCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
procedure DBGOutput(Sender: TObject; const AText: String);
@ -79,7 +81,12 @@ type
protected
procedure Loaded; override;
public
destructor Destroy; override;
destructor Destroy; override;
published
property Dummy: Boolean read FDummy write FDummy; // insert some dummies until fpcbug #1888 is fixed
property Dummy1: Boolean read FDummy write FDummy; // insert some dummies until fpcbug #1888 is fixed
property Dummy2: Boolean read FDummy write FDummy; // insert some dummies until fpcbug #1888 is fixed
property Dummy3: Boolean read FDummy write FDummy; // insert some dummies until fpcbug #1888 is fixed
end;
var
@ -112,6 +119,9 @@ begin
FDebugger := nil;
FBreakpointDlg := TBreakpointsDlg.Create(Application);
FBreakpointDlg.Show;
FLocalsDlg := TLocalsDlg.Create(Application);
FLocalsDlg.Show;
end;
procedure TDebugTestForm.FormDestroy(Sender: TObject);
@ -124,13 +134,16 @@ procedure TDebugTestForm.cmdInitClick(Sender: TObject);
begin
if FDebugger = nil
then begin
FDebugger := TGDBMIDebugger.Create;
FDebugger := TGDBMIDebugger.Create('/usr/bin/gdb');
FDebugger.OnDbgOutput := @DBGOutput;
FDebugger.OnOutput := @DBGTargetOutput;
FDebugger.OnCurrent := @DBGCurrent;
FDebugger.OnState := @DBGState;
TDBGBreakPointGroup(FDebugger.BreakPointGroups.Add).Name := 'Default';
FBreakpointDlg.Debugger := FDebugger;
FLocalsDlg.Debugger := FDebugger;
// Something strange going on here,
// sometimes the form crashes during load with Application as owner
// sometimes the form crashes during load with nil as owner
@ -274,6 +287,14 @@ initialization
end.
{ =============================================================================
$Log$
Revision 1.6 2002/03/23 15:54:30 lazarus
MWE:
+ Added locals dialog
* Modified breakpoints dialog (load as resource)
+ Added generic debuggerdlg class
= Reorganized main.pp, all debbugger relater routines are moved
to include/ide_debugger.inc
Revision 1.5 2002/03/12 23:55:36 lazarus
MWE:
* More delphi compatibility added/updated to TListView

26
debugger/tlocalsdlg.lfm Normal file
View File

@ -0,0 +1,26 @@
object LocalsDlg: TLocalsDlg
Left = 359
Top = 126
Width = 572
Height = 200
Caption = 'Locals'
object lvLocals: TListView
Left = 0
Top = 0
Width = 564
Height = 200
Align = alClient
Columns = <
item
Caption = 'Name'
Width = 150
end
item
Caption = 'Value'
Width = 400
end>
MultiSelect = True
ScrollBars = sbBoth
ViewStyle = vsReport
end
end

434
ide/include/ide_debugger.inc Normal file
View File

@ -0,0 +1,434 @@
{ $Id$}
{------------------------------------------------------------------------------}
{ All debugger related IDE routines }
{------------------------------------------------------------------------------}
{$IFDEF IDE_HEAD}
itmViewwatches : TMenuItem;
itmViewBreakpoints : TMenuItem;
itmViewDebugOutput: TMenuItem;
// Menu events
procedure mnuViewWatchesClick(Sender: TObject);
procedure mnuViewBreakPointsClick(Sender: TObject);
procedure mnuViewDebugOutputClick(Sender: TObject);
procedure mnuViewLocalsClick(Sender: TObject);
// SrcNotebook events
procedure OnSrcNotebookAddWatchesAtCursor(Sender: TObject);
procedure OnSrcNotebookCreateBreakPoint(Sender: TObject; Line: Integer);
procedure OnSrcNotebookDeleteBreakPoint(Sender: TObject; Line: Integer);
// Debugger events
procedure OnDebuggerChangeState(Sender: TObject);
procedure OnDebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
procedure OnDebuggerOutput(Sender: TObject; const AText: String);
procedure OnDebuggerException(Sender: TObject; const AExceptionID: Integer; const AExceptionText: String);
{$ELSE} {$IFDEF IDE_PRIVATE}
FBreakPoints: TDBGBreakPoints; // Points to debugger breakpoints if available
// Else to own objet
FDebugOutputDlg: TDBGOutputForm;
FBreakPointsDlg: TBreakPointsDlg;
FLocalsDlg: TLocalsDlg;
FDebugger: TDebugger;
procedure DebugConstructor;
procedure DebugLoadMenus;
procedure DebugDialogDestroy(Sender: TObject);
procedure ViewDebugDialog(const ADialogClass: TDebuggerDlgClass; var ADialog: TDebuggerDlg);
{$ELSE} {$IFDEF IDE_PUBLIC}
function DoInitDebugger: TModalResult;
function DoPauseProject: TModalResult;
function DoStepIntoProject: TModalResult;
function DoStepOverProject: TModalResult;
function DoRunToCursor: TModalResult;
function DoStopProject: TModalResult;
{$ELSE} {$IFDEF IDE_IMPLEMENTATION}
//=============================================================================
// I M P L E M E N T A T I O N
//=============================================================================
//-----------------------------------------------------------------------------
// IDE initialization
//-----------------------------------------------------------------------------
procedure TMainIDE.DebugConstructor;
begin
// TWatchesDlg
Watches_Dlg := TWatchesDlg.Create(Self);
FBreakPointsDlg := nil;
FLocalsDlg := nil;
FDebugger := nil;
FBreakPoints := TDBGBreakPoints.Create(nil, TDBGBreakPoint);
end;
procedure TMainIDE.DebugLoadMenus;
begin
end;
//-----------------------------------------------------------------------------
// Menu events
//-----------------------------------------------------------------------------
procedure TMainIDE.mnuViewWatchesClick(Sender : TObject);
begin
Watches_dlg.Show;
end;
procedure TMainIDE.mnuViewBreakPointsClick(Sender : TObject);
begin
ViewDebugDialog(TBreakPointsDlg, FBreakPointsDlg);
end;
procedure TMainIDE.mnuViewDebugOutputClick(Sender : TObject);
begin
ViewDebugDialog(TDBGOutputForm, FDebugOutputDlg);
end;
procedure TMainIDE.mnuViewLocalsClick(Sender : TObject);
begin
ViewDebugDialog(TLocalsDlg, FLocalsDlg);
end;
//-----------------------------------------------------------------------------
// ScrNoteBook events
//-----------------------------------------------------------------------------
procedure TMainIDE.OnSrcNotebookAddWatchesAtCursor(Sender : TObject);
var
SE : TSourceEditor;
WatchVar: String;
NewWatch: TdbgWatch;
begin
if FDebugger = nil then Exit;
//get the sourceEditor.
SE := TSourceNotebook(sender).GetActiveSE;
if not Assigned(SE) then Exit;
WatchVar := SE.GetWordAtCurrentCaret;
if WatchVar = '' then Exit;
NewWatch := TdbgWatch(FDebugger.Watches.Add);
NewWatch.Expression := WatchVar;
NewWatch.Enabled := True;
end;
procedure TMainIDE.OnSrcNotebookCreateBreakPoint(Sender: TObject; Line: Integer);
var
NewBreak: TDBGBreakPoint;
begin
if SourceNotebook.Notebook = nil then Exit;
NewBreak := FBreakPoints.Add(ExtractFilename(TSourceNotebook(sender).GetActiveSe.FileName), Line);
NewBreak.Enabled := True;
end;
procedure TMainIDE.OnSrcNotebookDeleteBreakPoint(Sender: TObject; Line: Integer);
begin
if SourceNotebook.Notebook = nil then Exit;
FBreakPoints.Find(ExtractFilename(TSourceNotebook(sender).GetActiveSe.FileName), Line).Free;
end;
//-----------------------------------------------------------------------------
// Debugger events
//-----------------------------------------------------------------------------
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.OnDebuggerOutput(Sender: TObject; const AText: String);
begin
if FDebugOutputDlg <> nil
then FDebugOutputDlg.AddText(AText);
end;
procedure TMainIDE.OnDebuggerChangeState(Sender: TObject);
const
// dsNone, dsIdle, dsStop, dsPause, dsRun, dsError
TOOLSTATEMAP: array[TDBGState] of TIDEToolStatus = (
// dsNone, dsIdle, dsStop, dsPause, dsRun, dsError
itNone, itNone, itNone, itDebugger, itDebugger, itDebugger
);
STATENAME: array[TDBGState] of string = (
'dsNone', 'dsIdle', 'dsStop', 'dsPause', 'dsRun', 'dsError'
);
begin
// Is the next line needed ???
if (Sender<>FDebugger) or (Sender=nil) then exit;
WriteLN('[TMainIDE.OnDebuggerChangeState] state: ', STATENAME[FDebugger.State]);
// All conmmands
// -------------------
// dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch
// -------------------
RunSpeedButton.Enabled := dcRun in FDebugger.Commands;
itmProjectRun.Enabled := RunSpeedButton.Enabled;
PauseSpeedButton.Enabled := dcPause in FDebugger.Commands;
itmProjectPause.Enabled := PauseSpeedButton.Enabled;
StepIntoSpeedButton.Enabled := dcStepInto in FDebugger.Commands;
itmProjectStepInto.Enabled := StepIntoSpeedButton.Enabled;
StepOverSpeedButton.Enabled := dcStepOver in FDebugger.Commands;
itmProjectStepOver.Enabled := StepOverSpeedButton.Enabled;
itmProjectRunToCursor.Enabled := dcRunTo in FDebugger.Commands;
itmProjectStop.Enabled := dcStop in FDebugger.Commands;;
// TODO: add other debugger menuitems
// TODO: implement by actions
ToolStatus := TOOLSTATEMAP[FDebugger.State];
if FDebugger.State = dsError
then begin
WriteLN('Ooops, the debugger entered the error state');
end;
end;
procedure TMainIDE.OnDebuggerCurrentLine(Sender: TObject;
const ALocation: TDBGLocationRec);
// debugger paused program due to pause or error
// -> show the current execution line in editor
// if SrcLine = -1 then no source is available
var
ActiveSrcEdit: TSourceEditor;
UnitFile: String;
begin
if (Sender<>FDebugger) or (Sender=nil) then exit;
//TODO: Show assembler window if no source can be found.
if ALocation.SrcLine = -1 then Exit;
UnitFile := FindUnitFile(ALocation.SrcFile);
if UnitFile = ''
then UnitFile := ALocation.SrcFile;
if DoOpenEditorFile(UnitFile, False, True) <> mrOk then exit;
ActiveSrcEdit := SourceNoteBook.GetActiveSE;
if ActiveSrcEdit=nil then exit;
with ActiveSrcEdit.EditorComponent do
begin
CaretXY:=Point(1, ALocation.SrcLine);
BlockBegin:=CaretXY;
BlockEnd:=CaretXY;
TopLine:=ALocation.SrcLine-(LinesInWindow div 2);
end;
ActiveSrcEdit.ErrorLine:=ALocation.SrcLine;
end;
//-----------------------------------------------------------------------------
// Debugger dialog routines
//-----------------------------------------------------------------------------
// Common handler
// The tag of the destroyed form contains the form variable pointing to it
procedure TMainIDE.DebugDialogDestroy(Sender: TObject);
begin
if TForm(Sender).Tag <> 0
then PPointer(TForm(Sender).Tag)^ := nil;
end;
procedure TMainIDE.ViewDebugDialog(const ADialogClass: TDebuggerDlgClass; var ADialog: TDebuggerDlg);
begin
if ADialog = nil
then begin
try
ADialog := ADialogClass.Create(Self);
except
on E: Exception do begin
WriteLN('[ERROR] IDE: Probably FPC bug #1888 caused an exception while creating class ''', ADialogClass.ClassName, '''');
WriteLN('[ERROR] IDE: Exception message: ', E.Message);
Exit;
end;
end;
ADialog.Tag := Integer(@ADialog);
ADialog.OnDestroy := @DebugDialogDestroy;
ADialog.Debugger := FDebugger;
end;
ADialog.Show;
ADialog.BringToFront;
end;
//-----------------------------------------------------------------------------
// Debugger routines
//-----------------------------------------------------------------------------
function TMainIDE.DoInitDebugger: TModalResult;
procedure ResetDialogs;
begin
FDebugOutputDlg.Debugger := FDebugger;
FBreakPointsDlg.Debugger := FDebugger;
FLocalsDlg.Debugger := FDebugger;
end;
var
OldBreakpoints: TDBGBreakpoints;
begin
WriteLN('[TMainIDE.DoInitDebugger] A');
Result:=mrCancel;
if Project.MainUnit < 0 then Exit;
OldBreakpoints := nil;
case EnvironmentOptions.DebuggerType of
dtGnuDebugger: begin
if (FDebugger <> nil)
and ( not(FDebugger is TGDBMIDebugger)
or (FDebugger.ExternalDebugger <> EnvironmentOptions.DebuggerFilename)
)
then begin
OldBreakpoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
OldBreakpoints.Assign(FBreakPoints);
FBreakPoints := nil;
FDebugger.Free;
FDebugger := nil;
end;
if FDebugger = nil
then begin
if FBreakPoints <> nil
then begin
OldBreakpoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
OldBreakpoints.Assign(FBreakPoints);
end;
FDebugger := TGDBMIDebugger.Create(EnvironmentOptions.DebuggerFilename);
FBreakPoints := FDebugger.BreakPoints;
end;
if OldBreakpoints <> nil
then FBreakPoints.Assign(OldBreakpoints);
end;
else
OldBreakpoints := FBreakPoints;
FBreakPoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
FBreakPoints.Assign(OldBreakpoints);
FDebugger.Free;
FDebugger := nil;
Exit;
end;
FDebugger.OnState:=@OnDebuggerChangeState;
FDebugger.OnCurrent:=@OnDebuggerCurrentLine;
FDebugger.OnDbgOutput := @OnDebuggerOutput;
FDebugger.OnException := @OnDebuggerException;
if FDebugger.State = dsNone
then FDebugger.Init;
//TODO: Show/hide debug menuitems based on FDebugger.SupportedCommands
// property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpoints
// property Watches: TDBGWatches read FWatches; // list of all watches localvars etc
Result := mrOk;
WriteLN('[TMainIDE.DoInitDebugger] END');
end;
// still part of main, should go here when dummydebugger is finished
//
//function TMainIDE.DoRunProject: TModalResult;
function TMainIDE.DoPauseProject: TModalResult;
begin
Result := mrCancel;
if (ToolStatus <> itDebugger)
or (FDebugger = nil)
then Exit;
FDebugger.Pause;
Result := mrOk;
end;
function TMainIDE.DoStepIntoProject: TModalResult;
begin
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
or (FDebugger = nil)
then begin
Result := mrAbort;
Exit;
end;
FDebugger.StepInto;
Result := mrOk;
end;
function TMainIDE.DoStepOverProject: TModalResult;
begin
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
or (FDebugger = nil)
then begin
Result := mrAbort;
Exit;
end;
FDebugger.StepOver;
Result := mrOk;
end;
function TMainIDE.DoStopProject: TModalResult;
begin
Result := mrCancel;
if (ToolStatus <> itDebugger)
or (FDebugger=nil)
then Exit;
FDebugger.Stop;
Result := mrOk;
end;
function TMainIDE.DoRunToCursor: TModalResult;
var
ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
UnitFilename: string;
begin
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
or (FDebugger = nil)
then begin
Result := mrAbort;
Exit;
end;
Result := mrCancel;
GetCurrentUnit(ActiveSrcEdit, ActiveUnitInfo);
if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil)
then begin
MessageDlg('Run to failed','Please open a unit before run.',mtError,
[mbCancel],0);
Exit;
end;
if not ActiveUnitInfo.Source.IsVirtual
then UnitFilename:=ActiveUnitInfo.Filename
else UnitFilename:=GetTestUnitFilename(ActiveUnitInfo);
FDebugger.RunTo(ExtractFilename(UnitFilename), ActiveSrcEdit.EditorComponent.CaretY);
Result := mrOK;
end;
//=============================================================================
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}

422
ide/main.pp
View File

@ -42,7 +42,7 @@ uses
Debugger, DBGOutputForm, GDBMIDebugger, RunParamsOpts, ExtToolDialog,
MacroPromptDlg, LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg, ColumnDlg,
OutputFilter, BuildLazDialog, MiscOptions, EditDefineTree, CodeToolsOptions,
TypInfo, IDEOptionDefs, CodeToolsDefines;
TypInfo, IDEOptionDefs, CodeToolsDefines, LocalsDlg, DebuggerDlg;
const
Version_String = '0.8.2 alpha';
@ -58,6 +58,10 @@ type
}
TIDEToolStatus = (itNone, itBuilder, itDebugger, itCustom);
{$DEFINE IDE_TYPE}
{$I ide_debugger.inc}
{$UNDEF IDE_TYPE}
TMainIDE = class(TForm)
pnlSpeedButtons : TPanel;
@ -132,9 +136,6 @@ type
itmViewCodeExplorer : TMenuItem;
itmViewForms : TMenuItem;
itmViewMessage : TMenuItem;
itmViewwatches : TMenuItem;
itmViewBreakpoints : TMenuItem;
itmViewDebugOutput: TMenuItem;
itmProjectNew: TMenuItem;
itmProjectOpen: TMenuItem;
@ -219,9 +220,6 @@ type
procedure mnuViewFormsClicked(Sender : TObject);
procedure mnuViewCodeExplorerClick(Sender : TObject);
procedure mnuViewMessagesClick(Sender : TObject);
procedure mnuViewWatchesClick(Sender : TObject);
procedure mnuViewBreakPointsClick(Sender : TObject);
procedure mnuViewDebugOutputClick(Sender : TObject);
procedure MessageViewDblClick(Sender : TObject);
procedure mnuToggleFormUnitClicked(Sender : TObject);
@ -292,9 +290,6 @@ type
procedure OnSrcNoteBookShowUnitInfo(Sender: TObject);
Procedure OnSrcNotebookToggleFormUnit(Sender : TObject);
Procedure OnSrcNotebookViewJumpHistory(Sender : TObject);
Procedure OnSrcNotebookAddWatchesAtCursor(Sender : TObject);
Procedure OnSrcNotebookCreateBreakPoint(Sender : TObject; Line : Integer);
Procedure OnSrcNotebookDeleteBreakPoint(Sender : TObject; Line : Integer);
// ObjectInspector + PropertyEditorHook events
procedure OIOnAddAvailableComponent(AComponent:TComponent;
@ -320,29 +315,21 @@ type
var Abort: boolean);
procedure OnAfterCodeToolBossApplyChanges(Manager: TCodeToolManager);
// Debugger events
procedure OnDebuggerChangeState(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);
// Hint Timer events
Procedure HintTimer1Timer(Sender : TObject);
// Watch Dialog events
Procedure OnWatchAdded(Sender : TObject; AnExpression : String);
// External Tools events
procedure OnExtToolNeedsOutputFilter(var OutputFilter: TOutputFilter;
var Abort: boolean);
procedure OnExtToolFreeOutputFilter(OutputFilter: TOutputFilter;
ErrorOccurred: boolean);
{$DEFINE IDE_HEAD}
{$I ide_debugger.inc}
{$UNDEF IDE_HEAD}
private
FHintSender : TObject;
FCodeLastActivated : Boolean; // used for toggling between code and forms
@ -353,21 +340,19 @@ type
MacroList: TTransferMacroList;
FMessagesViewBoundsRectValid: boolean;
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);
procedure OutputFormDestroy(Sender: TObject);
{$DEFINE IDE_PRIVATE}
{$I ide_debugger.inc}
{$UNDEF IDE_PRIVATE}
protected
procedure ToolButtonClick(Sender : TObject);
Procedure AddWatch(const AnExpression : String);
procedure OnApplyWindowLayout(ALayout: TIDEWindowLayout);
public
ToolStatus: TIDEToolStatus;
@ -404,11 +389,6 @@ type
function DoBuildProject(BuildAll: boolean): TModalResult;
function DoInitProjectRun: TModalResult;
function DoRunProject: TModalResult;
function DoPauseProject: TModalResult;
function DoStepIntoProject: TModalResult;
function DoStepOverProject: TModalResult;
function DoRunToCursor: TModalResult;
function DoStopProject: TModalResult;
function SomethingOfProjectIsModified: boolean;
function DoCreateProjectForProgram(ProgramBuf: TCodeBuffer): TModalResult;
function DoSaveProjectToTestDirectory: TModalResult;
@ -465,7 +445,6 @@ type
// methods for debugging, compiling and external tools
function DoJumpToCompilerMessage(Index:integer;
FocusEditor: boolean): boolean;
function DoInitDebugger: TModalResult;
procedure DoShowMessagesView;
procedure DoArrangeSourceEditorAndMessageView;
function GetProjectTargetFilename: string;
@ -500,6 +479,10 @@ type
procedure SaveEnvironment;
procedure LoadDesktopSettings(TheEnvironmentOptions: TEnvironmentOptions);
procedure SaveDesktopSettings(TheEnvironmentOptions: TEnvironmentOptions);
{$DEFINE IDE_PUBLIC}
{$I ide_debugger.inc}
{$UNDEF IDE_PUBLIC}
end;
@ -553,6 +536,9 @@ end;
{ TMainIDE }
{$DEFINE IDE_IMPLEMENTATION}
{$I ide_debugger.inc}
{$UNDEF IDE_IMPLEMENTATION}
constructor TMainIDE.Create(AOwner: TComponent);
const
@ -832,16 +818,8 @@ begin
'Launching target command line',nil,[]));
MacroList.OnSubstitution:=@OnMacroSubstitution;
// TWatchesDlg
Watches_Dlg := TWatchesDlg.Create(Self);
Watches_Dlg.OnWatchAddedEvent := @OnWatchAdded;
// TBreakPointsDlg
BreakPoints_Dlg := TBreakPointsDlg.Create(Self);
FDebugger := nil;
FBreakPoints := TDBGBreakPoints.Create(nil, TDBGBreakPoint);
DebugConstructor;
// control selection (selected components on edited form)
TheControlSelection:=TControlSelection.Create;
@ -1642,6 +1620,12 @@ begin
itmHelpAboutLazarus.OnCLick := @mnuHelpAboutLazarusClicked;
mnuHelp.Add(itmHelpAboutLazarus);
//--------------
// Other menu load routines
//--------------
DebugLoadMenus;
LoadMenuShortCuts;
end;
{------------------------------------------------------------------------------}
@ -4331,226 +4315,6 @@ begin
Writeln('[TMainIDE.DoRunProject] END');
end;
function TMainIDE.DoPauseProject: TModalResult;
begin
Result := mrCancel;
if (ToolStatus <> itDebugger)
or (FDebugger = nil)
then Exit;
FDebugger.Pause;
Result := mrOk;
end;
function TMainIDE.DoStepIntoProject: TModalResult;
begin
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
or (FDebugger = nil)
then begin
Result := mrAbort;
Exit;
end;
FDebugger.StepInto;
Result := mrOk;
end;
function TMainIDE.DoStepOverProject: TModalResult;
begin
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
or (FDebugger = nil)
then begin
Result := mrAbort;
Exit;
end;
FDebugger.StepOver;
Result := mrOk;
end;
function TMainIDE.DoStopProject: TModalResult;
begin
Result := mrCancel;
if (ToolStatus <> itDebugger)
or (FDebugger=nil)
then Exit;
FDebugger.Stop;
Result := mrOk;
end;
function TMainIDE.DoRunToCursor: TModalResult;
var
ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
UnitFilename: string;
begin
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
or (FDebugger = nil)
then begin
Result := mrAbort;
Exit;
end;
Result := mrCancel;
GetCurrentUnit(ActiveSrcEdit, ActiveUnitInfo);
if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil)
then begin
MessageDlg('Run to failed','Please open a unit before run.',mtError,
[mbCancel],0);
Exit;
end;
if not ActiveUnitInfo.Source.IsVirtual
then UnitFilename:=ActiveUnitInfo.Filename
else UnitFilename:=GetTestUnitFilename(ActiveUnitInfo);
FDebugger.RunTo(ExtractFilename(UnitFilename), ActiveSrcEdit.EditorComponent.CaretY);
Result := mrOK;
end;
function TMainIDE.DoInitDebugger: TModalResult;
var
OldBreakpoints: TDBGBreakpoints;
begin
WriteLN('[TMainIDE.DoInitDebugger] A');
Result:=mrCancel;
if Project.MainUnit < 0 then Exit;
OldBreakpoints := nil;
case EnvironmentOptions.DebuggerType of
dtGnuDebugger: begin
if (FDebugger <> nil)
and not (FDebugger is TGDBMIDebugger)
then begin
OldBreakpoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
OldBreakpoints.Assign(FBreakPoints);
FBreakPoints := nil;
FDebugger.Free;
FDebugger := nil;
end;
if FDebugger = nil
then begin
if FBreakPoints <> nil
then begin
OldBreakpoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
OldBreakpoints.Assign(FBreakPoints);
end;
FDebugger := TGDBMIDebugger.Create;
FBreakPoints := FDebugger.BreakPoints;
end;
if OldBreakpoints <> nil
then FBreakPoints.Assign(OldBreakpoints);
end;
else
OldBreakpoints := FBreakPoints;
FBreakPoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
FBreakPoints.Assign(OldBreakpoints);
FDebugger.Free;
FDebugger := nil;
Exit;
end;
//MainUnitInfo:=Project.Units[Project.MainUnit];
FDebugger.OnState:=@OnDebuggerChangeState;
FDebugger.OnCurrent:=@OnDebuggerCurrentLine;
FDebugger.OnDbgOutput := @OnDebuggerOutput;
FDebugger.OnException := @OnDebuggerException;
if FDebugger.State = dsNone
then FDebugger.Init;
//TODO: Show/hide debug menuitems based on FDebugger.SupportedCommands
// property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpoints
// property Watches: TDBGWatches read FWatches; // list of all watches localvars etc
Result := mrOk;
WriteLN('[TMainIDE.DoInitDebugger] END');
end;
procedure TMainIDE.OnDebuggerChangeState(Sender: TObject);
const
// dsNone, dsIdle, dsStop, dsPause, dsRun, dsError
TOOLSTATEMAP: array[TDBGState] of TIDEToolStatus = (
// dsNone, dsIdle, dsStop, dsPause, dsRun, dsError
itNone, itNone, itNone, itDebugger, itDebugger, itDebugger
);
STATENAME: array[TDBGState] of string = (
'dsNone', 'dsIdle', 'dsStop', 'dsPause', 'dsRun', 'dsError'
);
begin
// Is the next line needed ???
if (Sender<>FDebugger) or (Sender=nil) then exit;
WriteLN('[TMainIDE.OnDebuggerChangeState] state: ', STATENAME[FDebugger.State]);
// All conmmands
// -------------------
// dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch
// -------------------
RunSpeedButton.Enabled := dcRun in FDebugger.Commands;
itmProjectRun.Enabled := RunSpeedButton.Enabled;
PauseSpeedButton.Enabled := dcPause in FDebugger.Commands;
itmProjectPause.Enabled := PauseSpeedButton.Enabled;
StepIntoSpeedButton.Enabled := dcStepInto in FDebugger.Commands;
itmProjectStepInto.Enabled := StepIntoSpeedButton.Enabled;
StepOverSpeedButton.Enabled := dcStepOver in FDebugger.Commands;
itmProjectStepOver.Enabled := StepOverSpeedButton.Enabled;
itmProjectRunToCursor.Enabled := dcRunTo in FDebugger.Commands;
itmProjectStop.Enabled := dcStop in FDebugger.Commands;;
// TODO: add other debugger menuitems
// TODO: implement by actions
ToolStatus := TOOLSTATEMAP[FDebugger.State];
if FDebugger.State = dsError
then begin
WriteLN('Ooops, the debugger entered the error state');
end;
end;
procedure TMainIDE.OnDebuggerCurrentLine(Sender: TObject;
const ALocation: TDBGLocationRec);
// debugger paused program due to pause or error
// -> show the current execution line in editor
// if SrcLine = -1 then no source is available
var
ActiveSrcEdit: TSourceEditor;
UnitFile: String;
begin
if (Sender<>FDebugger) or (Sender=nil) then exit;
//TODO: Show assembler window if no source can be found.
if ALocation.SrcLine = -1 then Exit;
UnitFile := FindUnitFile(ALocation.SrcFile);
if UnitFile = ''
then UnitFile := ALocation.SrcFile;
if DoOpenEditorFile(UnitFile, False, True) <> mrOk then exit;
ActiveSrcEdit := SourceNoteBook.GetActiveSE;
if ActiveSrcEdit=nil then exit;
with ActiveSrcEdit.EditorComponent do
begin
CaretXY:=Point(1, ALocation.SrcLine);
BlockBegin:=CaretXY;
BlockEnd:=CaretXY;
TopLine:=ALocation.SrcLine-(LinesInWindow div 2);
end;
ActiveSrcEdit.ErrorLine:=ALocation.SrcLine;
end;
function TMainIDE.SomethingOfProjectIsModified: boolean;
begin
Result:=(Project<>nil)
@ -5969,114 +5733,6 @@ begin
end;
end;
Procedure TMainIDE.OnSrcNotebookAddWatchesAtCursor(Sender : TObject);
var
SE : TSourceEditor;
WatchVar : String;
begin
//get the sourceEditor.
SE := TSourceNotebook(sender).GetActiveSE;
if not Assigned(SE) then Exit;
WatchVar := SE.GetWordAtCurrentCaret;
if WatchVar = '' then Exit;
AddWatch(WatchVar);
end;
procedure TMainIDE.mnuViewWatchesClick(Sender : TObject);
begin
Watches_dlg.Show;
// CreateLFM(Watches_Dlg);
// CreateLFM(Insertwatch);
end;
procedure TMainIDE.mnuViewBreakPointsClick(Sender : TObject);
begin
Writeln('showing breakpoints');
BreakPoints_dlg.Show;
Writeln('DONE showing breakpoints');
// CreateLFM(Watches_Dlg);
// CreateLFM(Insertwatch);
end;
procedure TMainIDE.mnuViewDebugOutputClick(Sender : TObject);
begin
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
procedure TMainIDE.AddWatch(const AnExpression : String);
var
NewWatch : TdbgWatch;
begin
if FDebugger = nil then Exit;
if not Watches_Dlg.Visible then Watches_Dlg.Show;
NewWatch := TdbgWatch(FDebugger.watches.Add);
with NewWatch do
begin
Expression := AnExpression;
OnChange := @OnDebuggerWatchChanged;
Enabled := True;
end;
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.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
if not Watches_Dlg.Visible then Watches_Dlg.Show;
if Pos(':',AnExpression) > 0 then
AnExpression := Copy(AnExpression,1,pos(':',AnExpression)-1);
NewWatch := TdbgWatch(FDebugger.watches.Add);
with NewWatch do
Begin
Expression := AnExpression;
OnChange := @OnDebuggerWatchChanged;
Enabled := True;
end;
Watches_Dlg.UpdateWatch(NewWatch.Expression,NewWatch.Value);
end;
//this is fired when the editor is focused, changed, ?. Anything that causes the status change
Procedure TMainIDE.OnSrcNotebookEditorChanged(Sender : TObject);
begin
@ -6085,24 +5741,6 @@ begin
SaveSpeedBtn.Enabled := SourceNotebook.GetActiveSE.Modified;
end;
procedure TMainIDE.OnSrcNotebookCreateBreakPoint(Sender : TObject; Line : Integer);
var
NewBreak: TDBGBreakPoint;
begin
if SourceNotebook.Notebook = nil then Exit;
NewBreak := FBreakPoints.Add(ExtractFilename(TSourceNotebook(sender).GetActiveSe.FileName), Line);
NewBreak.Enabled := True;
end;
Procedure TMainIDE.OnSrcNotebookDeleteBreakPoint(Sender : TObject;
Line : Integer);
begin
if SourceNotebook.Notebook = nil then Exit;
FBreakPoints.Find(ExtractFilename(TSourceNotebook(sender).GetActiveSe.FileName), Line).Free;
end;
procedure TMainIDE.OnExtToolNeedsOutputFilter(var OutputFilter: TOutputFilter;
var Abort: boolean);
var ActiveSrcEdit: TSourceEditor;
@ -6462,6 +6100,14 @@ end.
{ =============================================================================
$Log$
Revision 1.252 2002/03/23 15:54:28 lazarus
MWE:
+ Added locals dialog
* Modified breakpoints dialog (load as resource)
+ Added generic debuggerdlg class
= Reorganized main.pp, all debbugger relater routines are moved
to include/ide_debugger.inc
Revision 1.251 2002/03/22 17:36:09 lazarus
MG: added include link history

4
ide/runparamsopts.pas
View File

@ -498,7 +498,7 @@ begin
Columns[1].Caption:='Value';
Columns.EndUpdate;
ViewStyle := vsReport;
Sorted := true;
SortType := stText;
Visible:=true;
end;
@ -529,7 +529,7 @@ begin
Columns[1].Caption:='Value';
Columns.EndUpdate;
ViewStyle := vsReport;
Sorted := true;
SortType := stText;
Visible:=true;
end;