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

DBG: (Unix) Added (very) basic support for console apps (console window)

Browse Source 
git-svn-id: trunk@30351 -
This commit is contained in:
martin 2011-04-17 15:44:14 +00:00
parent 71961a04c9
commit bf85980317
15 changed files with 373 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -2726,6 +2726,8 @@ debugger/localsdlg.lfm svneol=native#text/plain
debugger/localsdlg.pp svneol=native#text/pascal
debugger/processdebugger.pp svneol=native#text/plain
debugger/processlist.pas svneol=native#text/pascal
debugger/pseudoterminaldlg.lfm svneol=native#text/plain
debugger/pseudoterminaldlg.pp svneol=native#text/pascal
debugger/registersdlg.lfm svneol=native#text/pascal
debugger/registersdlg.pp svneol=native#text/pascal
debugger/sshgdbmidebugger.pas svneol=native#text/pascal

14
debugger/cmdlinedebugger.pp
View File

@ -55,7 +55,10 @@ type
FPeekOffset: Integer; // Count the number of lines we have peeked
FReadLineTimedOut: Boolean;
function GetDebugProcessRunning: Boolean;
function WaitForHandles(const AHandles: array of Integer; var ATimeOut: Integer): Integer; overload;
function WaitForHandles(const AHandles: array of Integer): Integer; overload;
protected
procedure ProcessWhileWaitForHandles; virtual;
function CreateDebugProcess(const AOptions: String): Boolean;
procedure Flush; // Flushes output buffer
function GetWaiting: Boolean; override;
@ -98,7 +101,7 @@ uses
TimeOut: Max Time in milli-secs => set to 0 if timeout occured
Returns: BitArray of handles set, 0 when an error occoured
------------------------------------------------------------------------------}
function WaitForHandles(const AHandles: array of Integer; var ATimeOut: Integer): Integer;
function TCmdLineDebugger.WaitForHandles(const AHandles: array of Integer; var ATimeOut: Integer): Integer;
{$IFDEF UNIX}
var
n, R, Max, Count: Integer;
@ -158,6 +161,7 @@ begin
end;
end;
ProcessWhileWaitForHandles;
inc(Step);
if Step=50 then begin
Step:=0;
@ -231,6 +235,7 @@ begin
end;
end;
ProcessWhileWaitForHandles;
// process messages
inc(Step);
if Step=20 then begin
@ -251,7 +256,7 @@ end;
{$ENDIF win32}
{$ENDIF linux}
function WaitForHandles(const AHandles: array of Integer): Integer; overload;
function TCmdLineDebugger.WaitForHandles(const AHandles: array of Integer): Integer; overload;
var
t: Integer;
begin
@ -259,6 +264,11 @@ begin
Result := WaitForHandles(AHandles, t);
end;
procedure TCmdLineDebugger.ProcessWhileWaitForHandles;
begin
// nothing
end;
//////////////////////////////////////////////////
{ TCmdLineDebugger }

31
debugger/debugger.pp
View File

@ -69,7 +69,8 @@ type
dcSetStackFrame,
dcDisassemble,
dcStepOverInstr,
dcStepIntoInstr
dcStepIntoInstr,
dcSendConsoleInput
);
TDBGCommands = set of TDBGCommand;
@ -1521,6 +1522,7 @@ type
FFileName: String;
FLocals: TDBGLocals;
FLineInfo: TDBGLineInfo;
FOnConsoleOutput: TDBGOutputEvent;
FRegisters: TDBGRegisters;
FShowConsole: Boolean;
FSignals: TDBGSignals;
@ -1599,6 +1601,7 @@ type
procedure StepOut;
procedure RunTo(const ASource: String; const ALine: Integer); // Executes til a certain point
procedure JumpTo(const ASource: String; const ALine: Integer); // No execute, only set exec point
procedure SendConsoleInput(AText: String);
function Evaluate(const AExpression: String; var AResult: String;
var ATypeInfo: TDBGType;
EvalFlags: TDBGEvaluateFlags = []): Boolean; // Evaluates the given expression, returns true if valid
@ -1641,6 +1644,7 @@ type
property OnOutput: TDBGOutputEvent read FOnOutput write FOnOutput; // Passes all output of the debugged target
property OnState: TDebuggerStateChangedEvent read FOnState write FOnState; // Fires when the current state of the debugger changes
property OnBreakPointHit: TDebuggerBreakPointHitEvent read FOnBreakPointHit write FOnBreakPointHit; // Fires when the program is paused at a breakpoint
property OnConsoleOutput: TDBGOutputEvent read FOnConsoleOutput write FOnConsoleOutput; // Passes Application Console Output
end;
TDebuggerClass = class of TDebugger;
@ -1663,7 +1667,8 @@ const
'SetStackFrame',
'Disassemble',
'StepOverInstr',
'StepIntoInstr'
'StepIntoInstr',
'SendConsoleInput'
);
DBGStateNames: array[TDBGState] of string = (
@ -1690,6 +1695,7 @@ function DBGBreakPointActionNameToAction(const s: string): TIDEBreakPointAction;
function dbgs(AState: TDBGState): String; overload;
function dbgs(ADisassRange: TDBGDisassemblerEntryRange): String; overload;
function HasConsoleSupport: Boolean;
(******************************************************************************)
(******************************************************************************)
(******************************************************************************)
@ -1702,12 +1708,13 @@ const
{dsNone } [],
{dsIdle } [dcEnvironment],
{dsStop } [dcRun, dcStepOver, dcStepInto, dcStepOverInstr, dcStepIntoInstr,
dcStepOut, dcRunTo, dcJumpto, dcBreak, dcWatch, dcEvaluate, dcEnvironment],
dcStepOut, dcRunTo, dcJumpto, dcBreak, dcWatch, dcEvaluate, dcEnvironment,
dcSendConsoleInput],
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcStepOverInstr, dcStepIntoInstr,
dcStepOut, dcRunTo, dcJumpto, dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify,
dcEnvironment, dcSetStackFrame, dcDisassemble],
dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput],
{dsInit } [],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch, dcEnvironment],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
{dsError} [dcStop],
{dsDestroying} []
);
@ -1738,6 +1745,15 @@ begin
end;
end;
function HasConsoleSupport: Boolean;
begin
{$IFDEF UNIX}
Result := True;
{$ELSE}
Result := False;
{$ENDIF}
end;
function DBGCommandNameToCommand(const s: string): TDBGCommand;
begin
for Result:=Low(TDBGCommand) to High(TDBGCommand) do
@ -2146,6 +2162,11 @@ begin
ReqCmd(dcJumpTo, [ASource, ALine]);
end;
procedure TDebugger.SendConsoleInput(AText: String);
begin
ReqCmd(dcSendConsoleInput, [AText]);
end;
function TDebugger.Modify(const AExpression, AValue: String): Boolean;
begin
Result := ReqCmd(dcModify, [AExpression, AValue]);

42
debugger/gdbmidebugger.pp
View File

@ -45,7 +45,7 @@ uses
Windows,
{$ENDIF}
{$IFDEF UNIX}
Unix,BaseUnix,termio,
Unix,BaseUnix,termio,PseudoTerminalDlg,
{$ENDIF}
BaseDebugManager, GDBMIMiscClasses;
@ -294,6 +294,7 @@ type
// Target info (move to record ?)
FTargetInfo: TGDBMITargetInfo;
procedure DoPseudoTerminalRead(Sender: TObject);
// Implementation of external functions
function GDBEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
function GDBEvaluate(const AExpression: String; var AResult: String;
@ -346,6 +347,10 @@ type
{$IFDEF MSWindows}
FPauseRequestInThreadID: Cardinal;
{$ENDIF}
{$IFDEF UNIX}
FPseudoTerminal: TPseudoTerminal;
procedure ProcessWhileWaitForHandles; override;
{$ENDIF}
procedure QueueExecuteLock;
procedure QueueExecuteUnlock;
@ -2942,8 +2947,9 @@ begin
ExecuteCommand('set width 50000', []);
{$IFDEF UNIX}
// Make sure consule output will ot be mixed with gbd output
FTheDebugger.FPseudoTerminal.Open;
s := TGDBMIDebuggerProperties(FTheDebugger.GetProperties).ConsoleTty;
if s = '' then s := '/dev/null';
if s = '' then s := FTheDebugger.FPseudoTerminal.Devicename;
h := fileopen(S, fmOpenWrite);
if (IsATTY(h) <> 1)
or (not ExecuteCommand('set inferior-tty %s', [s], R)) or (r.State = dsError)
@ -4188,7 +4194,7 @@ constructor TGDBMIDebuggerProperties.Create;
begin
FOverrideRTLCallingConvention := ccDefault;
{$IFDEF UNIX}
FConsoleTty := '/dev/null';
FConsoleTty := '';
{$ENDIF}
inherited;
end;
@ -4302,6 +4308,10 @@ begin
{$IFdef MSWindows}
InitWin32;
{$ENDIF}
{$IFDEF UNIX}
FPseudoTerminal := TPseudoTerminal.Create;
FPseudoTerminal.OnCanRead :=@DoPseudoTerminalRead;
{$ENDIF}
inherited;
end;
@ -4354,6 +4364,9 @@ begin
FreeAndNil(FCommandQueue);
ClearSourceInfo;
FreeAndNil(FSourceNames);
{$IFDEF UNIX}
FreeAndNil(FPseudoTerminal);
{$ENDIF}
end;
procedure TGDBMIDebugger.Done;
@ -4757,6 +4770,14 @@ begin
FreeAndNil(NewEntryMap);
end;
procedure TGDBMIDebugger.DoPseudoTerminalRead(Sender: TObject);
begin
{$IFDEF UNIX}
if assigned(OnConsoleOutput)
then OnConsoleOutput(self, FPseudoTerminal.Read);
{$ENDIF}
end;
function TGDBMIDebugger.GDBEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
var
S: String;
@ -5086,7 +5107,9 @@ begin
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcStepOut,
dcStepOverInstr, dcStepIntoInstr, dcRunTo, dcJumpto,
dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment,
dcSetStackFrame, dcDisassemble];
dcSetStackFrame, dcDisassemble
{$IFDEF UNIX}, dcSendConsoleInput{$ENDIF}
];
end;
function TGDBMIDebugger.GetTargetWidth: Byte;
@ -5322,6 +5345,9 @@ begin
String(AParams[5].VPointer^), Integer(AParams[6].VPointer^));
dcStepOverInstr: Result := GDBStepOverInstr;
dcStepIntoInstr: Result := GDBStepIntoInstr;
{$IFDEF UNIX}
dcSendConsoleInput: FPseudoTerminal.Write(String(AParams[0].VAnsiString));
{$ENDIF}
end;
finally
UnlockRelease;
@ -5529,6 +5555,14 @@ begin
Cmd.KeepFinished := False;
end;
{$IFDEF UNIX}
procedure TGDBMIDebugger.ProcessWhileWaitForHandles;
begin
inherited ProcessWhileWaitForHandles;
FPseudoTerminal.CheckCanRead;
end;
{$ENDIF}
procedure TGDBMIDebugger.QueueExecuteLock;
begin
inc(FCommandQueueExecLock);

150
debugger/gdbmimiscclasses.pp
View File

@ -30,7 +30,11 @@ unit GDBMIMiscClasses;
interface
uses
SysUtils, Debugger, DebugUtils;
SysUtils, Classes,
{$IFDEF UNIX}
libc,
{$ENDIF}
Debugger, DebugUtils;
type
@ -88,6 +92,34 @@ type
property UseTrim: Boolean read FUseTrim write FUseTrim;
end;
{$IFDEF UNIX}
const
InvalHandle = -1;
type
{ TPseudoTerminal }
TPseudoTerminal = class
private
FDeviceName: string;
FOnCanRead: TNotifyEvent;
FPTy: Integer;
FReadBuf: String;
procedure CloseInp;
public
constructor Create;
destructor Destroy; override;
procedure Open;
procedure Close;
function Write(s: string): Integer;
function Read: String;
procedure CheckCanRead;
property OnCanRead: TNotifyEvent read FOnCanRead write FOnCanRead;
property Devicename: string read FDeviceName;
end;
{$ENDIF}
implementation
{ TGDBMINameValueList }
@ -400,6 +432,122 @@ begin
Result := -1;
end;
{$IFDEF UNIX}
{ TPseudoTerminal }
procedure TPseudoTerminal.CloseInp;
var
ios: termios;
begin
// Based on MSEGui
if FPTy = InvalHandle then exit;
tcgetattr(FPty, @ios);
ios.c_lflag:= (ios.c_lflag and not (icanon)) or echo;
ios.c_cc[vmin]:= #0;
ios.c_cc[vtime]:= #0;
tcsetattr(FPty, tcsanow, @ios);
//foutput.writeln('');
end;
constructor TPseudoTerminal.Create;
begin
FPTy := InvalHandle;
end;
destructor TPseudoTerminal.Destroy;
begin
Close;
inherited Destroy;
end;
procedure TPseudoTerminal.Close;
begin
CloseInp;
if FPTy <> InvalHandle
then libc.__Close(FPTy);;
FPTy := InvalHandle;
end;
procedure TPseudoTerminal.Open;
const
BufLen = 100;
var
ios: termios;
int1: integer;
procedure Error;
begin
if FPTy <> InvalHandle
then libc.__Close(FPTy);;
FPTy := InvalHandle;
end;
begin
Close;
FPTy := getpt;
if FPTy < 0 then Error;
if (grantpt(FPTy) < 0) or (unlockpt(FPTy) < 0) then Error;
setlength(FDeviceName, BufLen);
if ptsname_r(FPTy, @FDeviceName[1], BufLen) < 0 then Error;
setlength(FDeviceName,length(pchar(FDeviceName)));
if tcgetattr(FPTy, @ios) <> 0 then Error;
ios.c_lflag:= ios.c_lflag and not (icanon); // or echo);
ios.c_cc[vmin]:= #1;
ios.c_cc[vtime]:= #0;
if tcsetattr(FPTy, tcsanow, @ios) <> 0 then Error;
int1 := fcntl(FPTy, f_getfl, 0);
if int1 = InvalHandle then Error;
if fcntl(FPTy, f_setfl, int1 or o_nonblock) = InvalHandle then Error;
end;
function TPseudoTerminal.Write(s: string): Integer;
var
int1, nbytes: Integer;
p: PChar;
begin
nbytes := length(s);
if (FPTy = InvalHandle) or (nbytes = 0) then exit(0);
Result:= nbytes;
p := @s[1];
repeat
int1 := libc.__write(FPTy, p^, nbytes);
if int1 = -1 then begin
if libc.errno <> eintr then begin
Result:= int1;
break;
end;
continue;
end;
inc(p, int1);
dec(nbytes, int1);
until integer(nbytes) <= 0;
end;
function TPseudoTerminal.Read: String;
const
BufLen = 1024;
var
buf: String;
i: Integer;
begin
SetLength(buf, BufLen + 1);
Result := FReadBuf;
FReadBuf := '';
repeat
i := libc.__read(FPTy, buf[1], BufLen);
if i > 0 then Result := Result + copy(buf, 1, i);
until i <= 0;
end;
procedure TPseudoTerminal.CheckCanRead;
begin
FReadBuf := Read;
if (FReadBuf <> '') and assigned(FOnCanRead)
then FOnCanRead(self);
end;
{$ENDIF}
end.

24
debugger/pseudoterminaldlg.lfm Normal file
View File

@ -0,0 +1,24 @@
inherited PseudoConsoleDlg: TPseudoConsoleDlg
Left = 1261
Top = 344
Caption = 'Console'
DockSite = True
object Memo1: TMemo[0]
Left = 0
Height = 213
Top = 0
Width = 320
Align = alClient
ReadOnly = True
TabOrder = 0
end
object Edit1: TEdit[1]
Left = 0
Height = 27
Top = 213
Width = 320
Align = alBottom
OnKeyPress = Edit1KeyPress
TabOrder = 1
end
end

60
debugger/pseudoterminaldlg.pp Normal file
View File

@ -0,0 +1,60 @@
unit PseudoTerminalDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil,
Forms, Controls, Graphics, Dialogs, StdCtrls, DebuggerDlg, BaseDebugManager;
type
{ TPseudoConsoleDlg }
TPseudoConsoleDlg = class(TDebuggerDlg)
Edit1: TEdit;
Memo1: TMemo;
procedure Edit1KeyPress(Sender: TObject; var Key: char);
private
{ private declarations }
protected
procedure DoClose(var CloseAction: TCloseAction); override;
public
{ public declarations }
procedure AddOutput(const AText: String);
end;
var
PseudoConsoleDlg: TPseudoConsoleDlg;
implementation
{ TPseudoConsoleDlg }
procedure TPseudoConsoleDlg.Edit1KeyPress(Sender: TObject; var Key: char);
begin
if Key <> #13 then exit;
DebugBoss.DoSendConsoleInput(Edit1.Text+LineEnding);
Edit1.Text := '';
end;
procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
begin
inherited DoClose(CloseAction);
CloseAction := caHide;
end;
procedure TPseudoConsoleDlg.AddOutput(const AText: String);
begin
Memo1.Text:=Memo1.Text+AText;
while Memo1.Lines.Count > 5000 do
Memo1.Lines.Delete(0);
Memo1.SelStart := length(Memo1.Text);
end;
{$R *.lfm}
end.

4
ide/basedebugmanager.pas
View File

@ -54,7 +54,8 @@ type
ddtEvaluate,
ddtRegisters,
ddtAssembler,
ddtInspect
ddtInspect,
ddtPseudoTerminal
);
{ TBaseDebugManager }
@ -128,6 +129,7 @@ type
function DoRunToCursor: TModalResult; virtual; abstract;
function DoStopProject: TModalResult; virtual; abstract;
procedure DoToggleCallStack; virtual; abstract;
procedure DoSendConsoleInput(AText: String); virtual; abstract;
procedure ProcessCommand(Command: word; var Handled: boolean); virtual; abstract;
procedure LockCommandProcessing; virtual; abstract;

44
ide/debugmanager.pas
View File

@ -56,7 +56,7 @@ uses
SourceMarks,
DebuggerDlg, Watchesdlg, BreakPointsdlg, BreakPropertyDlg, LocalsDlg, WatchPropertyDlg,
CallStackDlg, EvaluateDlg, RegistersDlg, AssemblerDlg, DebugOutputForm, ExceptionDlg,
InspectDlg, DebugEventsForm,
InspectDlg, DebugEventsForm, PseudoTerminalDlg,
GDBMIDebugger, SSHGDBMIDebugger, ProcessDebugger,
BaseDebugManager;
@ -79,6 +79,7 @@ type
procedure DebuggerCurrentLine(Sender: TObject; const ALocation: TDBGLocationRec);
procedure DebuggerOutput(Sender: TObject; const AText: String);
procedure DebuggerEvent(Sender: TObject; const ACategory: TDBGEventCategory; const AText: String);
procedure DebuggerConsoleOutput(Sender: TObject; const AText: String);
procedure DebuggerException(Sender: TObject;
const AExceptionType: TDBGExceptionType;
const AExceptionClass, AExceptionText: String;
@ -124,6 +125,7 @@ type
procedure InitDebugEventsDlg;
procedure InitBreakPointDlg;
procedure InitWatchesDlg;
procedure InitPseudoTerminal;
procedure InitLocalsDlg;
procedure InitCallStackDlg;
procedure InitEvaluateDlg;
@ -171,6 +173,7 @@ type
function DoRunToCursor: TModalResult; override;
function DoStopProject: TModalResult; override;
procedure DoToggleCallStack; override;
procedure DoSendConsoleInput(AText: String); override;
procedure ProcessCommand(Command: word; var Handled: boolean); override;
//Some debuugers may do things like ProcessMessages while processing commands
@ -212,7 +215,8 @@ implementation
const
DebugDlgIDEWindow: array[TDebugDialogType] of TNonModalIDEWindow = (
nmiwDbgOutput, nmiwDbgEvents, nmiwBreakPoints, nmiwWatches, nmiwLocals,
nmiwCallStack, nmiwEvaluate, nmiwRegisters, nmiwAssembler, nmiwInspect
nmiwCallStack, nmiwEvaluate, nmiwRegisters, nmiwAssembler, nmiwInspect,
nmiwPseudoTerminal
);
type
@ -960,6 +964,7 @@ var
Item: TIDEException;
begin
if FMaster = AValue then Exit;
Assert((FMaster=nil) or (AValue=nil), 'TManagedExceptions already has a Master');
FMaster := AValue;
if FMaster = nil
then begin
@ -1473,6 +1478,15 @@ begin
end;
end;
procedure TDebugManager.DebuggerConsoleOutput(Sender: TObject;
const AText: String);
begin
if not HasConsoleSupport then exit;;
if FDialogs[ddtPseudoTerminal] = nil
then ViewDebugDialog(ddtPseudoTerminal, False, False);
TPseudoConsoleDlg(FDialogs[ddtPseudoTerminal]).AddOutput(AText);
end;
procedure TDebugManager.BreakAutoContinueTimer(Sender: TObject);
begin
FAutoContinueTimer.Enabled := False;
@ -1516,6 +1530,7 @@ begin
ecToggleDebugEvents : ViewDebugDialog(ddtEvents);
ecEvaluate : ViewDebugDialog(ddtEvaluate);
ecInspect : ViewDebugDialog(ddtInspect);
ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal);
end;
end;
end;
@ -1916,12 +1931,15 @@ procedure TDebugManager.ViewDebugDialog(const ADialogType: TDebugDialogType;
const
DEBUGDIALOGCLASS: array[TDebugDialogType] of TDebuggerDlgClass = (
TDbgOutputForm, TDbgEventsForm, TBreakPointsDlg, TWatchesDlg, TLocalsDlg,
TCallStackDlg, TEvaluateDlg, TRegistersDlg, TAssemblerDlg, TIDEInspectDlg
TCallStackDlg, TEvaluateDlg, TRegistersDlg, TAssemblerDlg, TIDEInspectDlg,
TPseudoConsoleDlg
);
var
CurDialog: TDebuggerDlg;
begin
if Destroying then exit;
if (ADialogType = ddtPseudoTerminal) and not HasConsoleSupport
then exit;
if FDialogs[ADialogType] = nil
then begin
CurDialog := TDebuggerDlg(DEBUGDIALOGCLASS[ADialogType].NewInstance);
@ -1942,6 +1960,7 @@ begin
ddtEvaluate: InitEvaluateDlg;
ddtAssembler: InitAssemblerDlg;
ddtInspect: InitInspectDlg;
ddtPseudoTerminal: InitPseudoTerminal;
end;
end
else begin
@ -2015,6 +2034,14 @@ begin
TheDialog.Watches := FWatches;
end;
procedure TDebugManager.InitPseudoTerminal;
var
TheDialog: TPseudoConsoleDlg;
begin
if not HasConsoleSupport then exit;
TheDialog := TPseudoConsoleDlg(FDialogs[ddtPseudoTerminal]);
end;
procedure TDebugManager.InitLocalsDlg;
var
TheDialog: TLocalsDlg;
@ -2174,6 +2201,10 @@ begin
itmViewDebugOutput.Tag := Ord(ddtOutput);
itmViewDebugEvents.OnClick := @mnuViewDebugDialogClick;
itmViewDebugEvents.Tag := Ord(ddtEvents);
if itmViewPseudoTerminal <> nil then begin
itmViewPseudoTerminal.OnClick := @mnuViewDebugDialogClick;
itmViewPseudoTerminal.Tag := Ord(ddtPseudoTerminal);
end;
itmRunMenuResetDebugger.OnClick := @mnuResetDebuggerClicked;
@ -2580,6 +2611,7 @@ begin
FDebugger.OnDbgOutput := @DebuggerOutput;
FDebugger.OnDbgEvent := @DebuggerEvent;
FDebugger.OnException := @DebuggerException;
FDebugger.OnConsoleOutput :=@DebuggerConsoleOutput;
if FDebugger.State = dsNone
then begin
@ -2778,6 +2810,11 @@ begin
ViewDebugDialog(ddtCallStack);
end;
procedure TDebugManager.DoSendConsoleInput(AText: String);
begin
FDebugger.SendConsoleInput(AText);
end;
procedure TDebugManager.ProcessCommand(Command: word; var Handled: boolean);
begin
//debugln('TDebugManager.ProcessCommand ',dbgs(Command));
@ -2810,6 +2847,7 @@ begin
ecToggleDebuggerOut: ViewDebugDialog(ddtOutput);
ecToggleDebugEvents: ViewDebugDialog(ddtEvents);
ecToggleLocals: ViewDebugDialog(ddtLocals);
ecViewPseudoTerminal: ViewDebugDialog(ddtPseudoTerminal);
else
Handled := False;
end;

2
ide/ideoptiondefs.pas
View File

@ -93,6 +93,7 @@ type
nmiwRegisters,
nmiwAssembler,
nmiwInspect,
nmiwPseudoTerminal,
// extra
nmiwSearchResultsViewName,
nmiwAnchorEditor,
@ -138,6 +139,7 @@ const
'Registers',
'Assembler',
'Inspect',
'PseudoTerminal',
// extra
'SearchResults',
'AnchorEditor',

8
ide/keymapping.pp
View File

@ -36,7 +36,7 @@ uses
Forms, Classes, SysUtils, Buttons, LResources, Controls,
Dialogs, StringHashList, ExtCtrls,
SynEditKeyCmds, SynPluginTemplateEdit, SynPluginSyncroEdit, Laz_XMLCfg,
PropEdits, IDECommands, LazarusIDEStrConsts;
PropEdits, IDECommands, LazarusIDEStrConsts, Debugger;
type
TKeyMapScheme = (
@ -194,7 +194,6 @@ function CompareNameWithLoadedKeyCommand(NameAsAnsiString, Key: Pointer): intege
implementation
const
KeyMappingFormatVersion = 6;
@ -513,6 +512,7 @@ begin
ecToggleWatches: SetResult(VK_W,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleBreakPoints: SetResult(VK_B,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleLocals: SetResult(VK_L,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecViewPseudoTerminal: if HasConsoleSupport then SetResult(VK_T,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleCallStack: SetResult(VK_S,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleRegisters: SetResult(VK_R,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleAssembler: SetResult(VK_D,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
@ -1572,6 +1572,7 @@ begin
ecToggleWatches: SetResult(VK_W,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleBreakPoints: SetResult(VK_B,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleLocals: SetResult(VK_L,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecViewPseudoTerminal: if HasConsoleSupport then SetResult(VK_T,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleCallStack: SetResult(VK_S,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleRegisters: SetResult(VK_R,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
ecToggleAssembler: SetResult(VK_D,[ssCtrl,ssAlt],VK_UNKNOWN,[]);
@ -2078,6 +2079,7 @@ begin
ecToggleBreakPoints : Result:= srkmecToggleBreakPoints;
ecToggleDebuggerOut : Result:= srkmecToggleDebuggerOut;
ecToggleLocals : Result:= srkmecToggleLocals;
ecViewPseudoTerminal : Result:= srkmecViewPseudoTerminal;
ecToggleCallStack : Result:= srkmecToggleCallStack;
ecToggleRegisters : Result:= srkmecToggleRegisters;
ecToggleAssembler : Result:= srkmecToggleAssembler;
@ -2745,6 +2747,8 @@ begin
AddDefault(C, 'Toggle view Watches', lisKMToggleViewWatches, ecToggleWatches);
AddDefault(C, 'Toggle view Breakpoints', lisKMToggleViewBreakpoints, ecToggleBreakPoints);
AddDefault(C, 'Toggle view Local Variables', lisKMToggleViewLocalVariables, ecToggleLocals);
if HasConsoleSupport then
AddDefault(C, 'Toggle view Terminal Output', lisKMToggleViewPseudoTerminal, ecViewPseudoTerminal);
AddDefault(C, 'Toggle view Call Stack', lisKMToggleViewCallStack, ecToggleCallStack);
AddDefault(C, 'Toggle view Registers', lisKMToggleViewRegisters, ecToggleRegisters);
AddDefault(C, 'Toggle view Assembler', lisKMToggleViewAssembler, ecToggleAssembler);

3
ide/lazarusidestrconsts.pas
View File

@ -301,6 +301,7 @@ resourcestring
lisMenuViewWatches = 'Watches';
lisMenuViewBreakPoints = 'BreakPoints';
lisMenuViewLocalVariables = 'Local Variables';
lisMenuViewPseudoTerminal = 'Terminal Output';
lisMenuViewRegisters = 'Registers';
lisMenuViewCallStack = 'Call Stack';
lisMenuViewAssembler = 'Assembler';
@ -2600,6 +2601,7 @@ resourcestring
srkmecToggleBreakPoints = 'View breakpoints';
srkmecToggleDebuggerOut = 'View debugger output';
srkmecToggleLocals = 'View local variables';
srkmecViewPseudoTerminal = 'View Terminal Output';
srkmecTogglecallStack = 'View call stack';
srkmecToggleRegisters = 'View registers';
srkmecToggleAssembler = 'View assembler';
@ -2747,6 +2749,7 @@ resourcestring
lisKMToggleViewWatches = 'Toggle view Watches';
lisKMToggleViewBreakpoints = 'Toggle view Breakpoints';
lisKMToggleViewLocalVariables = 'Toggle view Local Variables';
lisKMToggleViewPseudoTerminal = 'Toggle view Terminal Output';
lisKMToggleViewCallStack = 'Toggle view Call Stack';
lisKMToggleViewRegisters = 'Toggle view Registers';
lisKMToggleViewAssembler = 'Toggle view Assembler';

1
ide/mainbar.pas
View File

@ -191,6 +191,7 @@ type
itmViewAssembler: TIDEMenuCommand;
itmViewDebugOutput: TIDEMenuCommand;
itmViewDebugEvents: TIDEMenuCommand;
itmViewPseudoTerminal: TIDEMenuCommand;
//itmViewIDEInternalsWindows: TIDEMenuSection;
itmViewPackageLinks: TIDEMenuCommand;
itmViewFPCInfo: TIDEMenuCommand;

6
ide/mainbase.pas
View File

@ -69,7 +69,7 @@ uses
EnvironmentOpts, EditorOptions, CompilerOptions, KeyMapping, IDEProcs,
Debugger, IDEOptionDefs, CodeToolsDefines, Splash, Designer,
SourceEditor, BuildManager, FindInFilesDlg,
MainBar, MainIntf;
MainBar, MainIntf, PseudoTerminalDlg;
type
TResetToolFlag = (
@ -529,6 +529,10 @@ begin
CreateMenuItem(itmViewDebugWindows,itmViewWatches,'itmViewWatches',lisMenuViewWatches,'debugger_watches');
CreateMenuItem(itmViewDebugWindows,itmViewBreakPoints,'itmViewBreakPoints',lisMenuViewBreakPoints,'debugger_breakpoints');
CreateMenuItem(itmViewDebugWindows,itmViewLocals,'itmViewLocals',lisMenuViewLocalVariables);
if HasConsoleSupport then
CreateMenuItem(itmViewDebugWindows,itmViewPseudoTerminal,'itmViewPseudoTerminal',lisMenuViewPseudoTerminal)
else
itmViewPseudoTerminal := nil;
CreateMenuItem(itmViewDebugWindows,itmViewRegisters,'itmViewRegisters',lisMenuViewRegisters);
CreateMenuItem(itmViewDebugWindows,itmViewCallStack,'itmViewCallStack',lisMenuViewCallStack,'debugger_call_stack');
CreateMenuItem(itmViewDebugWindows,itmViewAssembler,'itmViewAssembler',lisMenuViewAssembler);

1
ideintf/idecommands.pas
View File

@ -185,6 +185,7 @@ const
ecToggleRegisters = ecFirstLazarus + 325;
ecToggleAssembler = ecFirstLazarus + 326;
ecToggleDebugEvents = ecFirstLazarus + 327;
ecViewPseudoTerminal = ecFirstLazarus + 328;
// sourcenotebook commands
ecNextEditor = ecFirstLazarus + 330;