diff --git a/.gitattributes b/.gitattributes index aa193d2985..afe4ead914 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/debugger/breakpointsdlg.lrc b/debugger/breakpointsdlg.lrc index 679e2bcb24..34e2bc6ac0 100644 --- a/debugger/breakpointsdlg.lrc +++ b/debugger/breakpointsdlg.lrc @@ -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 ); diff --git a/debugger/breakpointsdlg.pp b/debugger/breakpointsdlg.pp index 31eaf1774a..0902b6b657 100644 --- a/debugger/breakpointsdlg.pp +++ b/debugger/breakpointsdlg.pp @@ -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 ) + @author(Shane Miller) + @author(Marc Weustink ) 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 diff --git a/debugger/cmdlinedebugger.pp b/debugger/cmdlinedebugger.pp index 6043d3c66c..4cec7bb3ab 100644 --- a/debugger/cmdlinedebugger.pp +++ b/debugger/cmdlinedebugger.pp @@ -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 diff --git a/debugger/dbgoutputform.lrc b/debugger/dbgoutputform.lrc index d8f5fdbe02..1a2d50f39f 100644 --- a/debugger/dbgoutputform.lrc +++ b/debugger/dbgoutputform.lrc @@ -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 ); diff --git a/debugger/dbgoutputform.pp b/debugger/dbgoutputform.pp index 4fe11b029c..c2d33da460 100644 --- a/debugger/dbgoutputform.pp +++ b/debugger/dbgoutputform.pp @@ -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 diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 8e2c8fdb20..3d499aa294 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -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 diff --git a/debugger/debuggerdlg.pp b/debugger/debuggerdlg.pp new file mode 100644 index 0000000000..a29b68e444 --- /dev/null +++ b/debugger/debuggerdlg.pp @@ -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 ) + + 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. \ No newline at end of file diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index f571698758..300456a9f8 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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 diff --git a/debugger/localsdlg.lrc b/debugger/localsdlg.lrc new file mode 100644 index 0000000000..40dfab9c61 --- /dev/null +++ b/debugger/localsdlg.lrc @@ -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 + ); diff --git a/debugger/localsdlg.pp b/debugger/localsdlg.pp new file mode 100644 index 0000000000..a254692d85 --- /dev/null +++ b/debugger/localsdlg.pp @@ -0,0 +1,125 @@ +{ $Id$ } +{ ---------------------------------------------- + localsdlg.pp - Overview of local variables + ---------------------------------------------- + + @created(Thu Mar 14st WET 2002) + @lastmod($Date$) + @author(Marc Weustink ) + + 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 + +} \ No newline at end of file diff --git a/debugger/tbreakpointsdlg.lfm b/debugger/tbreakpointsdlg.lfm index b5084a616e..73f2a22eb4 100644 --- a/debugger/tbreakpointsdlg.lfm +++ b/debugger/tbreakpointsdlg.lfm @@ -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 \ No newline at end of file diff --git a/debugger/tdbgoutputform.lfm b/debugger/tdbgoutputform.lfm index 22eecd57a8..534287395e 100644 --- a/debugger/tdbgoutputform.lfm +++ b/debugger/tdbgoutputform.lfm @@ -2,7 +2,6 @@ object DbgOutputForm1: TDbgOutputForm CAPTION = 'Debug output' OnClose = FormClose OnCreate = FormCreate - OnDestroy = FormDestroy HEIGHT = 200 WIDTH = 400 object txtOutput: TMemo diff --git a/debugger/test/debugtest.pp b/debugger/test/debugtest.pp index 85534ba5ed..0d5b79ffda 100644 --- a/debugger/test/debugtest.pp +++ b/debugger/test/debugtest.pp @@ -5,7 +5,7 @@ program debugtest; uses - Classes, Forms, DebugTestForm, BreakpointsDlg; + Classes, Forms, DebugTestForm, BreakpointsDlg, LocalsDlg; begin Application.Initialize; diff --git a/debugger/test/debugtestform.pp b/debugger/test/debugtestform.pp index ad1de19de0..ecdc46b59e 100644 --- a/debugger/test/debugtestform.pp +++ b/debugger/test/debugtestform.pp @@ -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 diff --git a/debugger/tlocalsdlg.lfm b/debugger/tlocalsdlg.lfm new file mode 100644 index 0000000000..1553326a4e --- /dev/null +++ b/debugger/tlocalsdlg.lfm @@ -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 diff --git a/ide/include/ide_debugger.inc b/ide/include/ide_debugger.inc new file mode 100644 index 0000000000..025b43169a --- /dev/null +++ b/ide/include/ide_debugger.inc @@ -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} diff --git a/ide/main.pp b/ide/main.pp index fc3b3e6507..3bbaf06c0d 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -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 diff --git a/ide/runparamsopts.pas b/ide/runparamsopts.pas index 0a02373999..b509a42ccd 100644 --- a/ide/runparamsopts.pas +++ b/ide/runparamsopts.pas @@ -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;