View Issue Details

IDProjectCategoryView StatusLast Update
0033935LazarusIDEpublic2019-02-24 21:46
ReporterMark Morgan LloydAssigned ToMartin Friebe 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
PlatformAnyOSOS Version
Product Version1.6.4Product Build 
Target VersionFixed in Version 
Summary0033935: Wishlist items for IDE debugger interface
DescriptionTwo wishlist items:

a) "Console" and "Debug Output" text could usefully be monospaced rather than proportional to match how the text would normally appear in a shell session (xterm etc.).

b) Would it be possible to detect a resize or maximise/restore of the "Console" window and send a SIGWINCH to the process being debugged? This might also need something like a TIOCSWINSZ ioctl, so that the program being debugged could get at least approximately the right result from TIOCGWINSZ. This would probably be unix-only, since I don't think Windows etc. signals text-mode programs on window resize.
Additional InformationI've been looking at a couple of console programs which do attempt to track window size changes, and in principle it /should/ be possible to modify Freevision/Dialedit for this.

/Please/ treat this as a wish rather than a whine, but so far I've not worked out how the relevant bits of the IDE hang together.
TagsNo tags attached.
Fixed in Revision
LazTarget-
WidgetsetQT
Attached Files
  • ttycontrol.patch (4,420 bytes)
    Index: components/debuggerintf/dbgintfdebuggerbase.pp
    ===================================================================
    --- components/debuggerintf/dbgintfdebuggerbase.pp	(revision 58438)
    +++ components/debuggerintf/dbgintfdebuggerbase.pp	(working copy)
    @@ -80,7 +80,8 @@
         dcDisassemble,
         dcStepOverInstr,
         dcStepIntoInstr,
    -    dcSendConsoleInput
    +    dcSendConsoleInput,
    +    dcSendSignal
         );
       TDBGCommands = set of TDBGCommand;
     
    @@ -1842,6 +1843,7 @@
         // prevent destruction while nested in any call
         procedure LockRelease; virtual;
         procedure UnlockRelease; virtual;
    +    function GetPseudoTerminal: TPseudoTerminal; virtual;
       public
         class function Caption: String; virtual;         // The name of the debugger as shown in the debuggeroptions
         class function ExePaths: String; virtual;        // The default locations of the exe
    @@ -1913,6 +1915,7 @@
         property Registers: TRegisterSupplier read FRegisters;                           // list of all registers
         property Signals: TDBGSignals read FSignals;                                 // A list of actions for signals we know
         property ShowConsole: Boolean read FShowConsole write FShowConsole;          // Indicates if the debugger should create a console for the debuggee
    +    property PseudoTerminal: TPseudoTerminal read GetPseudoTerminal; experimental 'may be replaced with a more general API';;
         property State: TDBGState read FState;                                       // The current state of the debugger
         property SupportedCommands: TDBGCommands read GetSupportedCommands;          // All available commands of the debugger
         property TargetWidth: Byte read GetTargetWidth;                              // Currently only 32 or 64
    @@ -2001,11 +2004,11 @@
                  dcSendConsoleInput],
       {dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcStepOverInstr, dcStepIntoInstr,
                  dcStepOut, dcRunTo, dcJumpto, dcDetach, dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify,
    -             dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput],
    +             dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput, dcSendSignal],
       {dsInternalPause} // same as run, so not really used
    -            [dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
    +            [dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput, dcSendSignal],
       {dsInit } [],
    -  {dsRun  } [dcPause, dcStop, dcDetach, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
    +  {dsRun  } [dcPause, dcStop, dcDetach, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput, dcSendSignal],
       {dsError} [dcStop],
       {dsDestroying} []
       );
    @@ -5857,6 +5860,11 @@
       FCurEnvironment.Assign(FEnvironment);
     end;
     
    +function TDebuggerIntf.GetPseudoTerminal: TPseudoTerminal;
    +begin
    +  Result := nil;
    +end;
    +
     //function TDebuggerIntf.GetUnitInfoProvider: TDebuggerUnitInfoProvider;
     //begin
     //  Result := FUnitInfoProvider;
    Index: components/lazdebuggergdbmi/gdbmidebugger.pp
    ===================================================================
    --- components/lazdebuggergdbmi/gdbmidebugger.pp	(revision 58438)
    +++ components/lazdebuggergdbmi/gdbmidebugger.pp	(working copy)
    @@ -860,6 +860,7 @@
         {$IFDEF DBG_ENABLE_TERMINAL}
         FPseudoTerminal: TPseudoTerminal;
         procedure ProcessWhileWaitForHandles; override;
    +    function GetPseudoTerminal: TPseudoTerminal; override;
         {$ENDIF}
         procedure QueueExecuteLock;
         procedure QueueExecuteUnlock;
    @@ -8909,6 +8910,7 @@
           {$IFDEF DBG_ENABLE_TERMINAL}
           dcSendConsoleInput: FPseudoTerminal.Write(String(AParams[0].VAnsiString));
           {$ENDIF}
    +      dcSendSignal: ; // kill(FTargetInfo, AParams[1]);
         end;
       finally
         UnlockRelease;
    @@ -9005,6 +9007,11 @@
       inherited ProcessWhileWaitForHandles;
       FPseudoTerminal.CheckCanRead;
     end;
    +
    +function TGDBMIDebugger.GetPseudoTerminal: TPseudoTerminal; override;
    +begin
    +  Result := FPseudoTerminal;
    +end;
     {$ENDIF}
     
     procedure TGDBMIDebugger.QueueExecuteLock;
    Index: debugger/pseudoterminaldlg.pp
    ===================================================================
    --- debugger/pseudoterminaldlg.pp	(revision 58438)
    +++ debugger/pseudoterminaldlg.pp	(working copy)
    @@ -40,6 +40,7 @@
       var UTF8Key: TUTF8Char);
     begin
       DebugBoss.DoSendConsoleInput(Utf8Key);
    +  //DebugBoss.Debugger.PseudoTerminal;
       Utf8Key := '';
     end;
     
    
    ttycontrol.patch (4,420 bytes)
  • debug-console-winch-support.diff (35,839 bytes)
    Index: components/debuggerintf/dbgintfdebuggerbase.pp
    ===================================================================
    --- components/debuggerintf/dbgintfdebuggerbase.pp	(revision 58442)
    +++ components/debuggerintf/dbgintfdebuggerbase.pp	(working copy)
    @@ -50,7 +50,7 @@
       // LazUtils
       LazClasses, LazLoggerBase, LazFileUtils, Maps, LazMethodList,
       // DebuggerIntf
    -  DbgIntfBaseTypes, DbgIntfMiscClasses;
    +  DbgIntfBaseTypes, DbgIntfMiscClasses, DbgIntfPseudoTerminal;
     
     const
       DebuggerIntfVersion = 0;
    @@ -80,7 +80,8 @@
         dcDisassemble,
         dcStepOverInstr,
         dcStepIntoInstr,
    -    dcSendConsoleInput
    +    dcSendConsoleInput,
    +    dcSendSignal
         );
       TDBGCommands = set of TDBGCommand;
     
    @@ -1842,6 +1843,7 @@
         // prevent destruction while nested in any call
         procedure LockRelease; virtual;
         procedure UnlockRelease; virtual;
    +    function GetPseudoTerminal: TPseudoTerminal; virtual;
       public
         class function Caption: String; virtual;         // The name of the debugger as shown in the debuggeroptions
         class function ExePaths: String; virtual;        // The default locations of the exe
    @@ -1913,6 +1915,7 @@
         property Registers: TRegisterSupplier read FRegisters;                           // list of all registers
         property Signals: TDBGSignals read FSignals;                                 // A list of actions for signals we know
         property ShowConsole: Boolean read FShowConsole write FShowConsole;          // Indicates if the debugger should create a console for the debuggee
    +    property PseudoTerminal: TPseudoTerminal read GetPseudoTerminal; experimental; // 'may be replaced with a more general API';
         property State: TDBGState read FState;                                       // The current state of the debugger
         property SupportedCommands: TDBGCommands read GetSupportedCommands;          // All available commands of the debugger
         property TargetWidth: Byte read GetTargetWidth;                              // Currently only 32 or 64
    @@ -2001,11 +2004,11 @@
                  dcSendConsoleInput],
       {dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcStepOverInstr, dcStepIntoInstr,
                  dcStepOut, dcRunTo, dcJumpto, dcDetach, dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify,
    -             dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput],
    +             dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput, dcSendSignal],
       {dsInternalPause} // same as run, so not really used
    -            [dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
    +            [dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput, dcSendSignal],
       {dsInit } [],
    -  {dsRun  } [dcPause, dcStop, dcDetach, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
    +  {dsRun  } [dcPause, dcStop, dcDetach, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput, dcSendSignal],
       {dsError} [dcStop],
       {dsDestroying} []
       );
    @@ -5857,6 +5860,11 @@
       FCurEnvironment.Assign(FEnvironment);
     end;
     
    +function TDebuggerIntf.GetPseudoTerminal: TPseudoTerminal;
    +begin
    +  Result := nil;
    +end;
    +
     //function TDebuggerIntf.GetUnitInfoProvider: TDebuggerUnitInfoProvider;
     //begin
     //  Result := FUnitInfoProvider;
    Index: components/debuggerintf/dbgintfpseudoterminal.pas
    ===================================================================
    --- components/debuggerintf/dbgintfpseudoterminal.pas	(nonexistent)
    +++ components/debuggerintf/dbgintfpseudoterminal.pas	(working copy)
    @@ -0,0 +1,208 @@
    +{            ----------------------------------------------------
    +              DbgIntfPsuedoTerminal.pp  -  Debugger helper class
    +             ----------------------------------------------------
    +
    +  This unit contains a helper class for a console containing a program being debugged.
    +
    +
    + ***************************************************************************
    + *                                                                         *
    + *   This source 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 code is distributed in the hope that it will be useful, but      *
    + *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
    + *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
    + *   General Public License for more details.                              *
    + *                                                                         *
    + *   A copy of the GNU General Public License is available on the World    *
    + *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
    + *   obtain it by writing to the Free Software Foundation,                 *
    + *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
    + *                                                                         *
    + ***************************************************************************
    +}
    +
    +unit DbgIntfPseudoTerminal;
    +
    +{$mode objfpc}{$H+}
    +{$IFDEF linux} {$DEFINE DBG_ENABLE_TERMINAL} {$ENDIF}
    +
    +interface
    +
    +uses
    +  Classes, SysUtils,
    +{$IFDEF DBG_ENABLE_TERMINAL}
    +IDEMiniLibC, BaseUnix;
    +{$ENDIF}
    +
    +{$IFDEF DBG_ENABLE_TERMINAL}
    +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 DevicePtyMaster: integer read FPty;
    +  property Devicename: string read FDeviceName;
    +end;
    +{$ENDIF}
    +
    +
    +implementation
    +
    +{$IFDEF DBG_ENABLE_TERMINAL}
    +
    +{ 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 __Close(FPTy);
    +  FPTy := InvalHandle;
    +end;
    +
    +procedure TPseudoTerminal.Open;
    +const
    +  BufLen = 100;
    +var
    +  ios: termios;
    +  int1: integer;
    +
    +  procedure Error;
    +  begin
    +    if FPTy <> InvalHandle
    +    then __Close(FPTy);
    +    FPTy := InvalHandle;
    +    FDeviceName := '';
    +  end;
    +
    +begin
    +  Close;
    +  FPTy := getpt;
    +  if FPTy < 0 then Error;
    +  if (grantpt(FPTy) < 0) or (unlockpt(FPTy) < 0) then begin
    +    Error;
    +    exit;
    +  end;
    +  setlength(FDeviceName, BufLen);
    +  if ptsname_r(FPTy, @FDeviceName[1], BufLen) < 0 then begin
    +    Error;
    +    exit;
    +  end;
    +  setlength(FDeviceName,length(pchar(FDeviceName)));
    +  if tcgetattr(FPTy, @ios) <> 0 then begin
    +    Error;
    +    exit;
    +  end;
    +  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 begin
    +    Error;
    +    exit;
    +  end;
    +
    +  int1 := fcntl(FPTy, f_getfl, 0);
    +  if int1 = InvalHandle then begin
    +    Error;
    +    exit;
    +  end;
    +  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 := __write(FPTy, p^, nbytes);
    +    if int1 = -1 then begin
    +      if 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
    +  if (FPTy = InvalHandle) then exit('');
    +
    +  SetLength(buf, BufLen + 1);
    +  Result := FReadBuf;
    +  FReadBuf := '';
    +  repeat
    +    i := __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.
    +
    Index: components/debuggerintf/debuggerintf.lpk
    ===================================================================
    --- components/debuggerintf/debuggerintf.lpk	(revision 58442)
    +++ components/debuggerintf/debuggerintf.lpk	(working copy)
    @@ -27,7 +27,7 @@
     Provides an interface to add debuggers to the IDE"/>
         <License Value="GPL-2"/>
         <Version Minor="1"/>
    -    <Files Count="3">
    +    <Files Count="5">
           <Item1>
             <Filename Value="dbgintfbasetypes.pas"/>
             <UnitName Value="DbgIntfBaseTypes"/>
    @@ -40,6 +40,14 @@
             <Filename Value="dbgintfmiscclasses.pas"/>
             <UnitName Value="DbgIntfMiscClasses"/>
           </Item3>
    +      <Item4>
    +        <Filename Value="ideminilibc.pas"/>
    +        <UnitName Value="IDEMiniLibC"/>
    +      </Item4>
    +      <Item5>
    +        <Filename Value="dbgintfpseudoterminal.pas"/>
    +        <UnitName Value="dbgintfpseudoterminal"/>
    +      </Item5>
         </Files>
         <RequiredPkgs Count="1">
           <Item1>
    Index: components/debuggerintf/debuggerintf.pas
    ===================================================================
    --- components/debuggerintf/debuggerintf.pas	(revision 58442)
    +++ components/debuggerintf/debuggerintf.pas	(working copy)
    @@ -8,7 +8,8 @@
     interface
     
     uses
    -  DbgIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfMiscClasses, LazarusPackageIntf;
    +  DbgIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfMiscClasses, IDEMiniLibC, 
    +  DbgIntfPseudoTerminal, LazarusPackageIntf;
     
     implementation
     
    Index: components/lazdebuggergdbmi/gdbmidebugger.pp
    ===================================================================
    --- components/lazdebuggergdbmi/gdbmidebugger.pp	(revision 58442)
    +++ components/lazdebuggergdbmi/gdbmidebugger.pp	(working copy)
    @@ -65,7 +65,7 @@
       LazFileUtils,
       {$ENDIF}
       DebugUtils, GDBTypeInfo, GDBMIDebugInstructions, GDBMIMiscClasses,
    -  DbgIntfBaseTypes, DbgIntfDebuggerBase, GdbmiStringConstants;
    +  DbgIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfPseudoTerminal, GdbmiStringConstants;
     
     type
       TGDBMIProgramInfo = record
    @@ -860,6 +860,7 @@
         {$IFDEF DBG_ENABLE_TERMINAL}
         FPseudoTerminal: TPseudoTerminal;
         procedure ProcessWhileWaitForHandles; override;
    +    function GetPseudoTerminal: TPseudoTerminal; override;
         {$ENDIF}
         procedure QueueExecuteLock;
         procedure QueueExecuteUnlock;
    @@ -8909,6 +8910,7 @@
           {$IFDEF DBG_ENABLE_TERMINAL}
           dcSendConsoleInput: FPseudoTerminal.Write(String(AParams[0].VAnsiString));
           {$ENDIF}
    +      dcSendSignal: ; // kill(FTargetInfo, AParams[1]);
         end;
       finally
         UnlockRelease;
    @@ -9005,6 +9007,11 @@
       inherited ProcessWhileWaitForHandles;
       FPseudoTerminal.CheckCanRead;
     end;
    +
    +function TGDBMIDebugger.GetPseudoTerminal: TPseudoTerminal;
    +begin
    +  Result := FPseudoTerminal;
    +end;
     {$ENDIF}
     
     procedure TGDBMIDebugger.QueueExecuteLock;
    Index: components/lazdebuggergdbmi/gdbmimiscclasses.pp
    ===================================================================
    --- components/lazdebuggergdbmi/gdbmimiscclasses.pp	(revision 58442)
    +++ components/lazdebuggergdbmi/gdbmimiscclasses.pp	(working copy)
    @@ -27,16 +27,11 @@
     
     unit GDBMIMiscClasses;
     {$mode objfpc}{$H+}
    -{$IFDEF linux} {$DEFINE DBG_ENABLE_TERMINAL} {$ENDIF}
     
     interface
     
     uses
    -  SysUtils,
    -  {$IFDEF DBG_ENABLE_TERMINAL}
    -  IDEMiniLibC, BaseUnix, Classes,
    -  {$ENDIF}
    -  DebugUtils, DbgIntfDebuggerBase;
    +    Classes, SysUtils, DebugUtils, DbgIntfDebuggerBase;
     
     type
     
    @@ -104,32 +99,7 @@
         property Text: String read GetText;
       end;
     
    -  {$IFDEF DBG_ENABLE_TERMINAL}
    -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 }
    @@ -451,141 +421,6 @@
       Result := -1;
     end;
     
    -{$IFDEF DBG_ENABLE_TERMINAL}
     
    -{ 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 __Close(FPTy);
    -  FPTy := InvalHandle;
    -end;
    -
    -procedure TPseudoTerminal.Open;
    -const
    -  BufLen = 100;
    -var
    -  ios: termios;
    -  int1: integer;
    -
    -  procedure Error;
    -  begin
    -    if FPTy <> InvalHandle
    -    then __Close(FPTy);
    -    FPTy := InvalHandle;
    -    FDeviceName := '';
    -  end;
    -
    -begin
    -  Close;
    -  FPTy := getpt;
    -  if FPTy < 0 then Error;
    -  if (grantpt(FPTy) < 0) or (unlockpt(FPTy) < 0) then begin
    -    Error;
    -    exit;
    -  end;
    -  setlength(FDeviceName, BufLen);
    -  if ptsname_r(FPTy, @FDeviceName[1], BufLen) < 0 then begin
    -    Error;
    -    exit;
    -  end;
    -  setlength(FDeviceName,length(pchar(FDeviceName)));
    -  if tcgetattr(FPTy, @ios) <> 0 then begin
    -    Error;
    -    exit;
    -  end;
    -  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 begin
    -    Error;
    -    exit;
    -  end;
    -
    -  int1 := fcntl(FPTy, f_getfl, 0);
    -  if int1 = InvalHandle then begin
    -    Error;
    -    exit;
    -  end;
    -  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 := __write(FPTy, p^, nbytes);
    -    if int1 = -1 then begin
    -      if 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
    -  if (FPTy = InvalHandle) then exit('');
    -
    -  SetLength(buf, BufLen + 1);
    -  Result := FReadBuf;
    -  FReadBuf := '';
    -  repeat
    -    i := __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.
     
    Index: components/lazdebuggergdbmi/lazdebuggergdbmi.lpk
    ===================================================================
    --- components/lazdebuggergdbmi/lazdebuggergdbmi.lpk	(revision 58442)
    +++ components/lazdebuggergdbmi/lazdebuggergdbmi.lpk	(working copy)
    @@ -20,7 +20,7 @@
     This debugger uses gdb and is based on gdb's mi interface."/>
         <License Value="GPL"/>
         <Version Minor="1"/>
    -    <Files Count="10">
    +    <Files Count="9">
           <Item1>
             <Filename Value="cmdlinedebugger.pp"/>
             <UnitName Value="CmdLineDebugger"/>
    @@ -38,32 +38,28 @@
             <UnitName Value="GDBMIMiscClasses"/>
           </Item4>
           <Item5>
    -        <Filename Value="ideminilibc.pas"/>
    -        <UnitName Value="IDEMiniLibC"/>
    -      </Item5>
    -      <Item6>
             <Filename Value="gdbmidebugger.pp"/>
             <HasRegisterProc Value="True"/>
             <UnitName Value="GDBMIDebugger"/>
    +      </Item5>
    +      <Item6>
    +        <Filename Value="gdbmidebuginstructions.pp"/>
    +        <UnitName Value="GDBMIDebugInstructions"/>
           </Item6>
           <Item7>
    -        <Filename Value="gdbmidebuginstructions.pp"/>
    -        <UnitName Value="GDBMIDebugInstructions"/>
    -      </Item7>
    -      <Item8>
             <Filename Value="gdbmiserverdebugger.pas"/>
             <HasRegisterProc Value="True"/>
             <UnitName Value="GDBMIServerDebugger"/>
    -      </Item8>
    -      <Item9>
    +      </Item7>
    +      <Item8>
             <Filename Value="sshgdbmidebugger.pas"/>
             <HasRegisterProc Value="True"/>
             <UnitName Value="SSHGDBMIDebugger"/>
    -      </Item9>
    -      <Item10>
    +      </Item8>
    +      <Item9>
             <Filename Value="gdbmistringconstants.pas"/>
             <UnitName Value="GdbmiStringConstants"/>
    -      </Item10>
    +      </Item9>
         </Files>
         <i18n>
           <EnableI18N Value="True"/>
    Index: components/lazdebuggergdbmi/lazdebuggergdbmi.pas
    ===================================================================
    --- components/lazdebuggergdbmi/lazdebuggergdbmi.pas	(revision 58442)
    +++ components/lazdebuggergdbmi/lazdebuggergdbmi.pas	(working copy)
    @@ -8,9 +8,9 @@
     interface
     
     uses
    -  CmdLineDebugger, DebugUtils, GDBTypeInfo, GDBMIMiscClasses, IDEMiniLibC, 
    -  GDBMIDebugger, GDBMIDebugInstructions, GDBMIServerDebugger, 
    -  SSHGDBMIDebugger, GdbmiStringConstants, LazarusPackageIntf;
    +  CmdLineDebugger, DebugUtils, GDBTypeInfo, GDBMIMiscClasses, GDBMIDebugger, 
    +  GDBMIDebugInstructions, GDBMIServerDebugger, SSHGDBMIDebugger, 
    +  GdbmiStringConstants, LazarusPackageIntf;
     
     implementation
     
    Index: debugger/debugger.pp
    ===================================================================
    --- debugger/debugger.pp	(revision 58442)
    +++ debugger/debugger.pp	(working copy)
    @@ -1743,7 +1743,8 @@
         'Disassemble',
         'StepOverInstr',
         'StepIntoInstr',
    -    'SendConsoleInput'
    +    'SendConsoleInput',
    +    'SendSignal'
         );
     
       DBGStateNames: array[TDBGState] of string = (
    Index: debugger/pseudoterminaldlg.lfm
    ===================================================================
    --- debugger/pseudoterminaldlg.lfm	(revision 58442)
    +++ debugger/pseudoterminaldlg.lfm	(working copy)
    @@ -1,9 +1,15 @@
    -inherited PseudoConsoleDlg: TPseudoConsoleDlg
    -  Left = 1261
    -  Top = 344
    +object PseudoConsoleDlg: TPseudoConsoleDlg
    +  Left = 697
    +  Height = 240
    +  Top = 327
    +  Width = 320
       Caption = 'Console'
    +  ClientHeight = 240
    +  ClientWidth = 320
       DockSite = True
    -  object Memo1: TMemo[0]
    +  OnResize = FormResize
    +  LCLVersion = '1.9.0.0'
    +  object Memo1: TMemo
         Left = 0
         Height = 240
         Top = 0
    Index: debugger/pseudoterminaldlg.pp
    ===================================================================
    --- debugger/pseudoterminaldlg.pp	(revision 58442)
    +++ debugger/pseudoterminaldlg.pp	(working copy)
    @@ -1,3 +1,31 @@
    +{              ------------------------------------------------
    +                PseudoTerminalDlg.pp  -  Debugger helper class
    +               ------------------------------------------------
    +
    +  This unit supports a form with a window acting as the console of a
    +  program being debugged, in particular in manages resize events.
    +
    +
    + ***************************************************************************
    + *                                                                         *
    + *   This source 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 code is distributed in the hope that it will be useful, but      *
    + *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
    + *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
    + *   General Public License for more details.                              *
    + *                                                                         *
    + *   A copy of the GNU General Public License is available on the World    *
    + *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
    + *   obtain it by writing to the Free Software Foundation,                 *
    + *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
    + *                                                                         *
    + ***************************************************************************
    +}
    +
     unit PseudoTerminalDlg;
     
     {$mode objfpc}{$H+}
    @@ -14,9 +42,17 @@
     
       TPseudoConsoleDlg = class(TDebuggerDlg)
         Memo1: TMemo;
    +    procedure FormResize(Sender: TObject);
         procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
       private
         { private declarations }
    +    ttyHandle: THandle;         (* Used only by unix for console size tracking  *)
    +    fCharHeight: word;
    +    fCharWidth: word;
    +    fRowsPerScreen: integer;
    +    fColsPerRow: integer;
    +    procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
    +    procedure consoleSizeChanged;
       protected
         procedure DoClose(var CloseAction: TCloseAction); override;
       public
    @@ -24,15 +60,29 @@
         constructor Create(TheOwner: TComponent); override;
         procedure AddOutput(const AText: String);
         procedure Clear;
    +    property CharHeight: word read fCharHeight;
    +    property CharWidth: word read fCharWidth;
    +    property RowsPerScreen: integer read fRowsPerScreen;
    +    property ColsPerRow: integer read fColsPerRow;
       end;
     
     var
       PseudoConsoleDlg: TPseudoConsoleDlg;
     
    +
     implementation
     
    +uses
    +  SysUtils, LazLoggerBase,
    +{$IFDEF UNIX}
    +  Unix, BaseUnix, termio;
    +{$ENDIF UNIX}
    +
    +const
    +  handleUnopened= THandle(-$80000000);
    +
     var
    -  PseudeoTerminalDlgWindowCreator: TIDEWindowCreator;
    +  PseudoTerminalDlgWindowCreator: TIDEWindowCreator;
     
     { TPseudoConsoleDlg }
     
    @@ -43,8 +93,49 @@
       Utf8Key := '';
     end;
     
    +
    +(* The form size has changed. Call a procedure to pass this to the kernel etc.,
    +  assuming that this works out the best control to track.
    +*)
    +procedure TPseudoConsoleDlg.FormResize(Sender: TObject);
    +
    +var
    +  ttyNotYetInitialised: boolean;
    +
    +begin
    +
    +(* These are not errors so much as conditions we will see while the IDE is      *)
    +(* starting up.                                                                 *)
    +
    +  if DebugBoss = nil then
    +    exit;
    +  if DebugBoss.Debugger = nil then
    +    exit;
    +  if DebugBoss.Debugger.PseudoTerminal = nil then
    +    exit;
    +
    +(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
    +(* so while we prefer success we also consider that failure /is/ an acceptable  *)
    +(* option in this case.                                                         *)
    +
    +  ttyNotYetInitialised := ttyHandle = handleUnopened;
    +  DebugLn(['TPseudoConsoleDlg.FormResize Calling consoleSizeChanged']);
    +  consoleSizeChanged;
    +  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
    +    DebugLn(['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
    +    ttyHandle := handleUnopened
    +  end
    +end;
    +
    +
     procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
     begin
    +{$IFDEF UNIX}
    +  if integer(ttyHandle) >= 0 then begin
    +    FileClose(ttyHandle);
    +    ttyHandle := handleUnopened
    +  end;
    +{$ENDIF UNIX}
       inherited DoClose(CloseAction);
       CloseAction := caHide;
     end;
    @@ -54,18 +145,158 @@
       inherited Create(TheOwner);
       font.Name := 'monospace';
       Caption:= lisDbgTerminal;
    +  ttyHandle := handleUnopened;
    +  fRowsPerScreen := -1;
    +  fColsPerRow := -1
     end;
     
    +
    +(* Get the height and width for characters described by the fount specified by
    +  the first parameter. This will normally be monospaced, but in case it's not
    +  use "W" which is normally the widest character in a typeface so that a
    +  subsequent conversion from a window size in pixels to one in character cells
    +  errs on the side of fewer rather than more rows and columns.
    +*)
    +procedure TPseudoConsoleDlg.getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
    +
    +var
    +  bm: TBitMap;
    +
    +begin
    +  bm := TBitmap.Create;
    +  try
    +    bm.Canvas.Font.Assign(consoleFont);
    +    h := bm.Canvas.TextHeight('W');
    +    w := bm.Canvas.TextWidth('W')
    +  finally
    +    bm.Free
    +  end
    +end;
    +
    +
    +(* Assume that the console size has changed, either because it's just starting
    +  to be used or because a window has been resized. Use an ioctl() to tell a TTY
    +  to reconsider its opinion of itself, and if necessary send an explicit signal
    +  to the process being debugged. Assume that this is peculiar to unix-like OSes,
    +  but may be called safely by others.
    +*)
    +procedure TPseudoConsoleDlg.consoleSizeChanged;
    +
    +{$IFDEF UNIX }
    +{ DEFINE USE_SLAVE_HANDLE }
    +{ DEFINE SEND_EXPLICIT_SIGNAL }
    +
    +var
    +{$IFDEF USE_SLAVE_HANDLE }
    +  s: string;
    +{$ENDIF USE_SLAVE_HANDLE }
    +  winSize: TWinSize;
    +
    +begin
    +  if ttyHandle = handleUnopened then
    +
    +(* Assume that we get here when the first character is to be written by the     *)
    +(* program being debugged, and that the form and memo are fully initialised.    *)
    +(* Leave ttyHandle either open (i.e. >= 0) or -ve but no longer handleUnopened, *)
    +(* in the latter case no further attempt will be made to use it.                *)
    +
    +// Requires -dDBG_WITH_DEBUGGER_DEBUG
    +
    +    if DebugBoss.Debugger.PseudoTerminal <> nil then begin
    +      DebugLn(['TPseudoConsoleDlg.AddOutput PseudoTerminal.DevicePtyMaster=',
    +                        DebugBoss.Debugger.PseudoTerminal.DevicePtyMaster]);
    +{$IFDEF USE_SLAVE_HANDLE }
    +      s := DebugBoss.Debugger.PseudoTerminal.Devicename;
    +      DebugLn(['TPseudoConsoleDlg.AddOutput PseudoTerminal.Devicename="', s, '"']);
    +      ttyHandle := fileopen(s, fmOpenWrite)
    +{$ELSE                   }
    +      ttyHandle := DebugBoss.Debugger.PseudoTerminal.DevicePtyMaster;
    +{$ENDIF USE_SLAVE_HANDLE }
    +      DebugLn(['TPseudoConsoleDlg.AddOutput ttyHandle=', ttyHandle]);
    +      getCharHeightAndWidth(Memo1.Font, fCharHeight, fCharWidth)
    +    end else begin                      (* Can't get pseudoterminal             *)
    +      DebugLn(['TPseudoConsoleDlg.AddOutput Unopened -> bad PseudoTerminal']);
    +      ttyHandle := THandle(-1)
    +    end;
    +
    +(* Every time we're called, provided that we were able to open the TTY, work    *)
    +(* out the window size and tell the kernel and/or process.                      *)
    +
    +  if integer(ttyHandle) >= 0 then begin (* Got slave TTY name and valid handle  *)
    +    with winSize do begin
    +      ws_xpixel := Memo1.Width;
    +      ws_ypixel := Memo1.Height;      (* Assume the fount is monospaced         *)
    +      ws_row := ws_ypixel div fCharHeight;
    +      ws_col := ws_xpixel div fCharwidth;
    +      DebugLn(['TPseudoConsoleDlg.AddOutput (rows x cols)=(', ws_row, ' x ', ws_col, ')']);
    +
    +(* TIOCGWINSZ reports the console size in both character cells and pixels, but  *)
    +(* since we're not likely to be emulating e.g. a Tektronix terminal or one of   *)
    +(* the higher-end DEC ones it's reasonable to bow out here if the size hasn't   *)
    +(* changed by at least a full row or character.                                 *)
    +
    +      if (ws_row = fRowsPerScreen) and (ws_col = fColsPerRow) then
    +        exit;
    +      fRowsPerScreen := ws_row;
    +      fColsPerRow := ws_col
    +    end;
    +
    +(* Note that when the Linux kernel (or appropriate driver etc.) gets TIOCSWINSZ *)
    +(* it takes it upon itself to raise a SIGWINCH, I've not tested whether other   *)
    +(* unix implementations do the same. Because this is an implicit action, and    *)
    +(* because by and large the process receiving the signal can identify the       *)
    +(* sender and would be entitled to be unhappy if the sender appeared to vary,   *)
    +(* I've not attempted to defer signal sending in cases where the process being  *)
    +(* debugged is in a paused state or is otherwise suspected to not be able to    *)
    +(* handle it immediately. MarkMLl (so you know who to kick).                    *)
    +
    +    if fpioctl(ttyHandle, TIOCSWINSZ, @winSize) < 0 then begin
    +      fileclose(ttyHandle);
    +      DebugLn(['TPseudoConsoleDlg.AddOutput Write failed, closed handle']);
    +      ttyHandle := THandle(-1)      (* Attempted ioctl() failed                 *)
    +    end;
    +    if integer(ttyHandle) >= 0 then begin (* Handle not closed by error         *)
    +{$IFDEF SEND_EXPLICIT_SIGNAL }
    +{$WARNING TPseudoConsoleDlg.consoleSizeChanged: Explicit signal untested }
    +
    +// If I'm reading things correctly ReqCmd() is private, so this needs fettling.
    +
    +      DebugBoss.Debugger.ReqCmd(dcSendSignal, [SIGWINCH]);
    +{$ENDIF SEND_EXPLICIT_SIGNAL }
    +      FillChar(winSize, sizeof(winSize), 0); (* Did it work?                    *)
    +      fpioctl(ttyHandle, TIOCGWINSZ, @winSize);
    +      DebugLn(['TPseudoConsoleDlg.AddOutput readback=(', winSize.ws_row, ' x ', winSize.ws_col, ')'])
    +    end
    +  end;
    +{$ELSE       }
    +begin
    +  ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
    +{$ENDIF UNIX }
    +  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
    +end;
    +
    +
     procedure TPseudoConsoleDlg.AddOutput(const AText: String);
    +
     begin
    -  Memo1.Text:=Memo1.Text+AText;
    +  if ttyHandle = handleUnopened then begin (* Do this at first output only      *)
    +    DebugLn(['TPseudoConsoleDlg.AddOutput Calling consoleSizeChanged']);
    +    consoleSizeChanged
    +  end;
       while Memo1.Lines.Count > 5000 do
         Memo1.Lines.Delete(0);
    +
    +// Working note: make any adjustment to the number of lines etc. before we
    +// start to add text which might include escape handling.
    +
    +  Memo1.Text:=Memo1.Text+AText;
       Memo1.SelStart := length(Memo1.Text);
     end;
     
     procedure TPseudoConsoleDlg.Clear;
     begin
    +  DebugLn(['TPseudoConsoleDlg.Clear Calling FormResize']);
    +  FormResize(nil);                      (* Safe during IDE initialisation       *)
       Memo1.Text := '';
     end;
     
    @@ -73,9 +304,9 @@
     
     initialization
     
    -  PseudeoTerminalDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtPseudoTerminal]);
    -  PseudeoTerminalDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
    -  PseudeoTerminalDlgWindowCreator.CreateSimpleLayout;
    +  PseudoTerminalDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtPseudoTerminal]);
    +  PseudoTerminalDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
    +  PseudoTerminalDlgWindowCreator.CreateSimpleLayout;
     
     end.
     
    Index: debugger/test/watchconsolesize.lpi
    ===================================================================
    --- debugger/test/watchconsolesize.lpi	(nonexistent)
    +++ debugger/test/watchconsolesize.lpi	(working copy)
    @@ -0,0 +1,53 @@
    +<?xml version="1.0" encoding="UTF-8"?>
    +<CONFIG>
    +  <ProjectOptions>
    +    <Version Value="11"/>
    +    <General>
    +      <Flags>
    +        <MainUnitHasCreateFormStatements Value="False"/>
    +        <MainUnitHasScaledStatement Value="False"/>
    +      </Flags>
    +      <SessionStorage Value="InProjectDir"/>
    +      <MainUnit Value="0"/>
    +      <Title Value="My Application"/>
    +      <UseAppBundle Value="False"/>
    +      <ResourceType Value="res"/>
    +    </General>
    +    <BuildModes Count="1">
    +      <Item1 Name="Default" Default="True"/>
    +    </BuildModes>
    +    <PublishOptions>
    +      <Version Value="2"/>
    +    </PublishOptions>
    +    <RunParams>
    +      <FormatVersion Value="2"/>
    +      <Modes Count="0"/>
    +    </RunParams>
    +    <Units Count="1">
    +      <Unit0>
    +        <Filename Value="watchconsolesize.pas"/>
    +        <IsPartOfProject Value="True"/>
    +        <UnitName Value="WatchConsoleSize"/>
    +      </Unit0>
    +    </Units>
    +  </ProjectOptions>
    +  <CompilerOptions>
    +    <Version Value="11"/>
    +    <Target>
    +      <Filename Value="watchconsolesize"/>
    +    </Target>
    +    <SearchPaths>
    +      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    +    </SearchPaths>
    +  </CompilerOptions>
    +  <Debugging>
    +    <Exceptions Count="2">
    +      <Item1>
    +        <Name Value="EAbort"/>
    +      </Item1>
    +      <Item2>
    +        <Name Value="ECodetoolError"/>
    +      </Item2>
    +    </Exceptions>
    +  </Debugging>
    +</CONFIG>
    Index: debugger/test/watchconsolesize.pas
    ===================================================================
    --- debugger/test/watchconsolesize.pas	(nonexistent)
    +++ debugger/test/watchconsolesize.pas	(working copy)
    @@ -0,0 +1,67 @@
    +program WatchConsoleSize;
    +
    +(* This console-mode program for Linux or other unix implementations reports	*)
    +(* on the initial console size and outputs a message every time it gets a	*)
    +(* SIGWINCH indicating that the console window has been resized.		*)
    +(*										*)
    +(* It DOES NOT attempt any formatted output using escape sequences etc. MarkMLl	*)
    +
    +uses
    +  SysUtils, Keyboard, Crt, TermIO, BaseUnix;
    +
    +var
    +  signalCount: integer= 0;
    +
    +
    +procedure reportSize;
    +
    +var
    +  winSize: TWinSize;
    +
    +begin
    +  Write(signalCount, ': ');
    +  FillChar(winSize, sizeof(winSize), 0);
    +  if IsaTty(StdInputHandle) = 1 then
    +    if fpioctl(StdInputHandle, TIOCGWINSZ, @winSize) >= 0 then
    +      Write(winSize.ws_row, ' x ', winSize.ws_col);
    +  WriteLn;
    +  signalCount += 1
    +end { reportSize } ;
    +
    +
    +procedure winchHandler(sig: longint; {%H-}info: PSigInfo; {%H-}context: PSigContext); cdecl;
    +
    +begin
    +  case sig of
    +    SIGWINCH: reportSize
    +  otherwise
    +  end
    +end { winchHandler } ;
    +
    +
    +function hookWinch(): boolean;
    +
    +var
    +  action: SigActionRec;
    +
    +begin
    +  FillChar(action{%H-}, SizeOf(action), 0);
    +  action.Sa_Handler := @winchHandler;
    +  action.Sa_Flags := SA_SIGINFO;
    +  hookWinch := fpSigAction(SIGWINCH, @action, nil) = 0
    +end { hookWinch } ;
    +
    +
    +begin
    +  WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
    +  reportSize;
    +  if not hookWinch() then
    +    WriteLn('Failed: SIGWINCH not hooked, error ', fpGetErrNo)
    +  else begin
    +    while not KeyPressed() do
    +      Sleep(10);
    +    ReadKey
    +  end;
    +  WriteLn('It ends here.')
    +end.
    +  
    Index: ide/lazarus.lpi
    ===================================================================
    --- ide/lazarus.lpi	(revision 58442)
    +++ ide/lazarus.lpi	(working copy)
    @@ -39,7 +39,9 @@
         </PublishOptions>
         <RunParams>
           <FormatVersion Value="2"/>
    -      <Modes Count="0"/>
    +      <Modes Count="1">
    +        <Mode0 Name="default"/>
    +      </Modes>
         </RunParams>
         <RequiredPackages Count="7">
           <Item1>
    @@ -1427,9 +1429,12 @@
         <SearchPaths>
           <IncludeFiles Value="include"/>
           <OtherUnitFiles Value="frames;../converter;../debugger;../debugger/frames;../packager;../designer;../packager/frames;../ide"/>
    -      <UnitOutputDirectory Value="$(LazarusDir)/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
    +      <UnitOutputDirectory Value="/usr/local/share/lazarus-trunk2/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
         </SearchPaths>
    -    <CompileReasons Compile="False" Build="False" Run="False"/>
    +    <Other>
    +      <CustomOptions Value="-dDBG_WITH_DEBUGGER_DEBUG"/>
    +    </Other>
    +    <CompileReasons Run="False"/>
       </CompilerOptions>
       <Debugging>
         <Exceptions Count="2">
    Index: ide/lazarus.res
    ===================================================================
    Cannot display: file marked as a binary type.
    svn:mime-type = application/octet-stream
    
  • debug-console-unformatted.diff (32,913 bytes)
    Index: debugger/pseudoterminaldlg.lfm
    ===================================================================
    --- debugger/pseudoterminaldlg.lfm	(revision 58484)
    +++ debugger/pseudoterminaldlg.lfm	(working copy)
    @@ -1,24 +1,210 @@
     object PseudoConsoleDlg: TPseudoConsoleDlg
    -  Left = 697
    -  Height = 240
    -  Top = 327
    -  Width = 320
    +  Left = 438
    +  Height = 480
    +  Top = 321
    +  Width = 800
       Caption = 'Console'
    -  ClientHeight = 240
    -  ClientWidth = 320
    +  ClientHeight = 480
    +  ClientWidth = 800
       DockSite = True
       OnResize = FormResize
       LCLVersion = '1.9.0.0'
    -  object Memo1: TMemo
    +  object PageControl1: TPageControl
         Left = 0
    -    Height = 240
    +    Height = 460
         Top = 0
    -    Width = 320
    +    Width = 800
    +    ActivePage = TabSheetRaw
         Align = alClient
    -    OnUTF8KeyPress = Memo1UTF8KeyPress
    -    ReadOnly = True
    -    ScrollBars = ssAutoBoth
    +    TabIndex = 1
         TabOrder = 0
    -    WantTabs = True
    +    object TabSheet1: TTabSheet
    +      Caption = 'Formatted'
    +      ClientHeight = 430
    +      ClientWidth = 790
    +      TabVisible = False
    +      object Panel1: TPanel
    +        Left = 470
    +        Height = 430
    +        Top = 0
    +        Width = 160
    +        Align = alRight
    +        Caption = 'Panel1'
    +        TabOrder = 0
    +      end
    +    end
    +    object TabSheetRaw: TTabSheet
    +      Caption = 'Raw Output'
    +      ClientHeight = 430
    +      ClientWidth = 790
    +      object PairSplitterRaw: TPairSplitter
    +        Left = 0
    +        Height = 430
    +        Top = 0
    +        Width = 790
    +        Align = alClient
    +        Position = 600
    +        object PairSplitterRawLeft: TPairSplitterSide
    +          Cursor = crArrow
    +          Left = 0
    +          Height = 430
    +          Top = 0
    +          Width = 600
    +          ClientWidth = 600
    +          ClientHeight = 430
    +          object Memo1: TMemo
    +            Left = 4
    +            Height = 422
    +            Top = 4
    +            Width = 592
    +            Align = alClient
    +            BorderSpacing.Around = 4
    +            Font.Name = 'Monospace'
    +            OnUTF8KeyPress = Memo1UTF8KeyPress
    +            ParentFont = False
    +            ReadOnly = True
    +            ScrollBars = ssAutoBoth
    +            TabOrder = 0
    +            WantTabs = True
    +          end
    +        end
    +        object PairSplitterRawRight: TPairSplitterSide
    +          Cursor = crArrow
    +          Left = 605
    +          Height = 430
    +          Top = 0
    +          Width = 185
    +          ClientWidth = 185
    +          ClientHeight = 430
    +          OnResize = PairSplitterRawRightResize
    +          object RadioGroupRight: TRadioGroup
    +            Left = 0
    +            Height = 103
    +            Top = 0
    +            Width = 185
    +            Align = alTop
    +            AutoFill = True
    +            AutoSize = True
    +            Caption = 'Output Style'
    +            ChildSizing.LeftRightSpacing = 6
    +            ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
    +            ChildSizing.EnlargeVertical = crsHomogenousChildResize
    +            ChildSizing.ShrinkHorizontal = crsScaleChilds
    +            ChildSizing.ShrinkVertical = crsScaleChilds
    +            ChildSizing.Layout = cclLeftToRightThenTopToBottom
    +            ChildSizing.ControlsPerLine = 1
    +            ClientHeight = 84
    +            ClientWidth = 183
    +            ItemIndex = 0
    +            Items.Strings = (
    +              'Unformatted'
    +              'C0 as Control Pictures'
    +              'C0 as ISO 2047'
    +              'Hex + ASCII'
    +            )
    +            OnSelectionChanged = RadioGroupRightSelectionChanged
    +            TabOrder = 1
    +          end
    +          object PanelRightBelowRG: TPanel
    +            Left = 0
    +            Height = 327
    +            Top = 103
    +            Width = 185
    +            Align = alClient
    +            BevelOuter = bvNone
    +            ClientHeight = 327
    +            ClientWidth = 185
    +            TabOrder = 0
    +            object CheckGroupRight: TCheckGroup
    +              Left = 0
    +              Height = 73
    +              Top = 0
    +              Width = 185
    +              Align = alTop
    +              AutoFill = True
    +              AutoSize = True
    +              Caption = 'Decorations'
    +              ChildSizing.LeftRightSpacing = 6
    +              ChildSizing.TopBottomSpacing = 6
    +              ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
    +              ChildSizing.EnlargeVertical = crsHomogenousChildResize
    +              ChildSizing.ShrinkHorizontal = crsScaleChilds
    +              ChildSizing.ShrinkVertical = crsScaleChilds
    +              ChildSizing.Layout = cclLeftToRightThenTopToBottom
    +              ChildSizing.ControlsPerLine = 1
    +              ClientHeight = 54
    +              ClientWidth = 183
    +              Enabled = False
    +              Items.Strings = (
    +                'Line numbers'
    +                'C1 as C0 + Underbar'
    +              )
    +              TabOrder = 1
    +              Data = {
    +                020000000202
    +              }
    +            end
    +            object PanelRightBelowCG: TPanel
    +              Left = 0
    +              Height = 254
    +              Top = 73
    +              Width = 185
    +              Align = alClient
    +              BevelOuter = bvNone
    +              ClientHeight = 254
    +              ClientWidth = 185
    +              TabOrder = 0
    +              object GroupBoxRight: TGroupBox
    +                Left = 0
    +                Height = 64
    +                Top = 0
    +                Width = 185
    +                Align = alTop
    +                Caption = 'Line limit'
    +                ClientHeight = 45
    +                ClientWidth = 183
    +                TabOrder = 0
    +                object MaskEdit1: TMaskEdit
    +                  Left = 9
    +                  Height = 30
    +                  Top = 0
    +                  Width = 128
    +                  CharCase = ecNormal
    +                  MaxLength = 7
    +                  TabOrder = 0
    +                  EditMask = '#######'
    +                  Text = '5000   '
    +                  SpaceChar = '_'
    +                end
    +              end
    +            end
    +          end
    +        end
    +      end
    +    end
       end
    +  object StatusBar1: TStatusBar
    +    Left = 0
    +    Height = 20
    +    Top = 460
    +    Width = 800
    +    Panels = <    
    +      item
    +        Text = '    dumb'
    +        Width = 160
    +      end    
    +      item
    +        Text = '00 x 00 chars'
    +        Width = 160
    +      end    
    +      item
    +        Text = '000 x 000 pixels'
    +        Width = 160
    +      end    
    +      item
    +        Text = 'Not resized'
    +        Width = 160
    +      end>
    +    SimplePanel = False
    +  end
     end
    Index: debugger/pseudoterminaldlg.pp
    ===================================================================
    --- debugger/pseudoterminaldlg.pp	(revision 58484)
    +++ debugger/pseudoterminaldlg.pp	(working copy)
    @@ -33,8 +33,9 @@
     interface
     
     uses
    -  IDEWindowIntf, Classes, Graphics,
    -  Forms, StdCtrls, DebuggerDlg, BaseDebugManager, LazarusIDEStrConsts, LCLType;
    +  IDEWindowIntf, Classes, Graphics, Forms, StdCtrls, DebuggerDlg,
    +  BaseDebugManager, LazarusIDEStrConsts, LCLType, ComCtrls, ExtCtrls, MaskEdit,
    +  PairSplitter;
     
     type
     
    @@ -41,9 +42,25 @@
       { TPseudoConsoleDlg }
     
       TPseudoConsoleDlg = class(TDebuggerDlg)
    +    CheckGroupRight: TCheckGroup;
    +    GroupBoxRight: TGroupBox;
    +    MaskEdit1: TMaskEdit;
         Memo1: TMemo;
    +    PageControl1: TPageControl;
    +    PairSplitterRaw: TPairSplitter;
    +    PairSplitterRawLeft: TPairSplitterSide;
    +    PairSplitterRawRight: TPairSplitterSide;
    +    Panel1: TPanel;
    +    PanelRightBelowRG: TPanel;
    +    PanelRightBelowCG: TPanel;
    +    RadioGroupRight: TRadioGroup;
    +    StatusBar1: TStatusBar;
    +    TabSheet1: TTabSheet;
    +    TabSheetRaw: TTabSheet;
         procedure FormResize(Sender: TObject);
         procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
    +    procedure PairSplitterRawRightResize(Sender: TObject);
    +    procedure RadioGroupRightSelectionChanged(Sender: TObject);
       private
         { private declarations }
         ttyHandle: System.THandle;         (* Used only by unix for console size tracking  *)
    @@ -51,6 +68,7 @@
         fCharWidth: word;
         fRowsPerScreen: integer;
         fColsPerRow: integer;
    +    fFirstLine: integer;
         procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
         procedure consoleSizeChanged;
       protected
    @@ -73,7 +91,7 @@
     implementation
     
     uses
    -  SysUtils, LazLoggerBase
    +  SysUtils, StrUtils, LazLoggerBase
     {$IFDEF UNIX}
       , Unix, BaseUnix, termio
     {$ENDIF UNIX}
    @@ -96,6 +114,50 @@
     end;
     
     
    +procedure TPseudoConsoleDlg.PairSplitterRawRightResize(Sender: TObject);
    +
    +var
    +  ttyNotYetInitialised: boolean;
    +
    +begin
    +
    +(* These are not errors so much as conditions we will see while the IDE is      *)
    +(* starting up.                                                                 *)
    +
    +  if DebugBoss = nil then
    +    exit;
    +  if DebugBoss.PseudoTerminal = nil then
    +    exit;
    +
    +(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
    +(* so while we prefer success we also consider that failure /is/ an acceptable  *)
    +(* option in this case.                                                         *)
    +
    +  ttyNotYetInitialised := ttyHandle = handleUnopened;
    +  //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.SplitterRawRightResize Calling consoleSizeChanged']);
    +  consoleSizeChanged;
    +  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
    +    DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.SplitterRawRightResize Bad PseudoTerminal -> unopened']);
    +    ttyHandle := handleUnopened
    +  end;
    +  StatusBar1.Panels[3].Text := 'Splitter resized'
    +end { TPseudoConsoleDlg.PairSplitterRawRightResize } ;
    +
    +
    +(* The C1 underbar decoration is only relevant when C0 is being displayed as
    +  control pictures or ISO 2047 glyphs.
    +*)
    +procedure TPseudoConsoleDlg.RadioGroupRightSelectionChanged(Sender: TObject);
    +
    +begin
    +  case RadioGroupRight.ItemIndex of
    +    1, 2: CheckGroupRight.CheckEnabled[1] := true
    +  otherwise
    +    CheckGroupRight.CheckEnabled[1] := false
    +  end
    +end { TPseudoConsoleDlg.RadioGroupRightSelectionChanged } ;
    +
    +
     (* The form size has changed. Call a procedure to pass this to the kernel etc.,
       assuming that this works out the best control to track.
     *)
    @@ -124,11 +186,13 @@
       if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
         DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
         ttyHandle := handleUnopened
    -  end
    -end;
    +  end;
    +  StatusBar1.Panels[3].Text := 'Window resized'
    +end { TPseudoConsoleDlg.FormResize } ;
     
     
     procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
    +
     begin
     {$IFDEF UNIX}
       if integer(ttyHandle) >= 0 then begin
    @@ -138,9 +202,11 @@
     {$ENDIF UNIX}
       inherited DoClose(CloseAction);
       CloseAction := caHide;
    -end;
    +end { TPseudoConsoleDlg.DoClose } ;
     
    +
     constructor TPseudoConsoleDlg.Create(TheOwner: TComponent);
    +
     begin
       inherited Create(TheOwner);
       font.Name := 'monospace';
    @@ -147,8 +213,9 @@
       Caption:= lisDbgTerminal;
       ttyHandle := handleUnopened;
       fRowsPerScreen := -1;
    -  fColsPerRow := -1
    -end;
    +  fColsPerRow := -1;
    +  fFirstLine := 1
    +end { TPseudoConsoleDlg.Create } ;
     
     
     (* Get the height and width for characters described by the fount specified by
    @@ -171,7 +238,7 @@
       finally
         bm.Free
       end
    -end;
    +end { TPseudoConsoleDlg.getCharHeightAndWidth } ;
     
     
     (* Assume that the console size has changed, either because it's just starting
    @@ -273,34 +340,413 @@
     begin
       ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
     {$ENDIF UNIX }
    -  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
    -end;
    +  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit');
    +  RadioGroupRightSelectionChanged(nil); (* Sort out initial state               *)
    +  StatusBar1.Panels[0].Width := Width div 4;
    +  StatusBar1.Panels[0].Text := '    ' ; // + DebugBoss.Debugger.Environment.Values['TERM'];
    +  StatusBar1.Panels[1].Width := Width div 4;
    +  StatusBar1.Panels[1].Text := Format('%d cols x %d rows', [winsize.ws_col, winsize.ws_row]);
    +  StatusBar1.Panels[2].Width := Width div 4;
    +  StatusBar1.Panels[2].Text := Format('%d x %d pixels', [winsize.ws_xpixel, winsize.ws_ypixel])
    +end { TPseudoConsoleDlg.consoleSizeChanged } ;
     
     
     procedure TPseudoConsoleDlg.AddOutput(const AText: String);
     
    +var
    +  lineLimit, numLength, i: integer;
    +  buffer: TStringList;
    +
    +
    +  (* Translate C0 control codes to "control pictures", and optionally C1 codes
    +    to the same glyph but with an underbar.
    +  *)
    +  function withControlPictures(const str: widestring; c1Underbar: boolean): widestring;
    +
    +  const
    +    nul= #$2400;                        // ␀
    +    soh= #$2401;                        // ␁
    +    stx= #$2402;                        // ␂
    +    etx= #$2403;                        // ␃
    +    eot= #$2404;                        // ␄
    +    enq= #$2405;                        // ␅
    +    ack= #$2406;                        // ␆
    +    bel= #$2407;                        // ␇
    +    bs=  #$2408;                        // ␈
    +    ht=  #$2409;                        // ␉
    +    lf=  #$240a;                        // ␊
    +    vt=  #$240b;                        // ␋
    +    ff=  #$240c;                        // ␌
    +    cr=  #$240d;                        // ␍
    +    so=  #$240e;                        // ␎
    +    si=  #$240f;                        // ␏
    +    dle= #$2410;                        // ␐
    +    dc1= #$2411;                        // ␑
    +    dc2= #$2412;                        // ␒
    +    dc3= #$2413;                        // ␓
    +    dc4= #$2414;                        // ␔
    +    nak= #$2415;                        // ␕
    +    syn= #$2416;                        // ␖
    +    etb= #$2417;                        // ␗
    +    can= #$2418;                        // ␘
    +    em=  #$2419;                        // ␙
    +    sub= #$241a;                        // ␚
    +    esc= #$241b;                        // ␛
    +    fs=  #$241c;                        // ␜
    +    gs=  #$241d;                        // ␝
    +    rs=  #$241e;                        // ␞
    +    us=  #$241f;                        // ␟
    +    del= #$2420;                        // ␡
    +    bar= #$033c;                        // ̼'
    +
    +  var
    +    i, test, masked: integer;
    +
    +  begin
    +    result := str;
    +
    +  (* This should probably be recoded to use a persistent table, but doing it    *)
    +  (* this way results in no lookup for plain text which is likely to be the     *)
    +  (* bulk of the output. I'm not making any assumptions about the Unicode       *)
    +  (* characters being sequential so that this code can be used both for control *)
    +  (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
    +  (* want to adjust them he can do so.                                          *)
    +
    +    for i := Length(result) downto 1 do begin
    +      test := Ord(result[i]);
    +      if c1Underbar then
    +        masked := test and $7f          (* Handle both C0 and C1 in one operation *)
    +      else
    +        masked := test;
    +      case masked of
    +        $00: result[i] := nul;
    +        $01: result[i] := soh;
    +        $02: result[i] := stx;
    +        $03: result[i] := etx;
    +        $04: result[i] := eot;
    +        $05: result[i] := enq;
    +        $06: result[i] := ack;
    +        $07: result[i] := bel;
    +        $08: result[i] := bs;
    +        $09: result[i] := ht;
    +        $0a: result[i] := lf;
    +        $0b: result[i] := vt;
    +        $0c: result[i] := ff;
    +        $0d: result[i] := cr;
    +        $0e: result[i] := so;
    +        $0f: result[i] := si;
    +        $10: result[i] := dle;
    +        $11: result[i] := dc1;
    +        $12: result[i] := dc2;
    +        $13: result[i] := dc3;
    +        $14: result[i] := dc4;
    +        $15: result[i] := nak;
    +        $16: result[i] := syn;
    +        $17: result[i] := etb;
    +        $18: result[i] := can;
    +        $19: result[i] := em;
    +        $1a: result[i] := sub;
    +        $1b: result[i] := esc;
    +        $1c: result[i] := fs;
    +        $1d: result[i] := gs;
    +        $1e: result[i] := rs;
    +        $1f: result[i] := us;
    +        $7f: result[i] := del
    +      otherwise
    +      end;
    +      if c1Underbar and                 (* Now fix changed C1 characters        *)
    +                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
    +                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
    +        Insert(bar, result, i + 1)
    +    end
    +  end { withControlPictures } ;
    +
    +
    +  (* Translate C0 control codes to "pretty pictures", and optionally C1 codes
    +    to the same glyph but with an underbar.
    +  *)
    +  function withIso2047(const str: widestring; c1Underbar: boolean): widestring;
    +
    +  (* I've not got access to a pukka copy of ISO-2047, so like (it appears)      *)
    +  (* almost everybody else I'm assuming that the Wikipedia page is correct.     *)
    +  (* this differs from the ECMA standard (only) in the backspace glyph, some    *)
    +  (* terminals in particular the Burroughs TD730/830 range manufactured in the  *)
    +  (* 1970s and 1980s depart slightly more. I've found limited open source       *)
    +  (* projects that refer to this encoding, and those I've found have attempted  *)
    +  (* to "correct" details like the "direction of rotation" of the glyphs for    *)
    +  (* the DC1 through DC4 codes.                                                 *)
    +  (*                                                                            *)
    +  (* Suffixes W, E and B below refer to the variants found in the Wikipedia     *)
    +  (* article, the ECMA standard and the Burroughs terminal documentation.       *)
    +
    +  const
    +    nul=  #$2395;                       // ⎕
    +    soh=  #$2308;                       // ⌈
    +    stx=  #$22A5;                       // ⊥
    +    etx=  #$230B;                       // ⌋
    +    eot=  #$2301;                       // ⌁
    +    enq=  #$22A0;                       // ⊠
    +    ack=  #$2713;                       // ✓
    +    bel=  #$237E;                       // ⍾
    +    bsW=  #$232B;                       // ⌫
    +    bsB=  #$2196;                       // ↖ The ECMA glyph is slightly curved
    +    bs=   bsB;                          //   and has no Unicode representation.
    +    ht=   #$2AAB;                       // ⪫
    +    lf=   #$2261;                       // ≡
    +    vt=   #$2A5B;                       // ⩛
    +    ff=   #$21A1;                       // ↡
    +    crW=  #$2aaa;                       // ⪪ ECMA the same
    +    crB=  #$25bf;                       // ▿
    +    cr=   crW;
    +    so=   #$2297;                       // ⊗
    +    si=   #$2299;                       // ⊙
    +    dle=  #$229F;                       // ⊟
    +    dc1=  #$25F7;                       // ◷ Nota bene: these rotate deosil
    +    dc2=  #$25F6;                       // ◶
    +    dc3=  #$25F5;                       // ◵
    +    dc4=  #$25F4;                       // ◴
    +    nak=  #$237B;                       // ⍻
    +    syn=  #$238D;                       // ⎍
    +    etb=  #$22A3;                       // ⊣
    +    can=  #$29D6;                       // ⧖
    +    em=   #$237F;                       // ⍿
    +    sub=  #$2426;                       // ␦
    +    esc=  #$2296;                       // ⊖
    +    fs=   #$25F0;                       // ◰ Nota bene: these rotate widdershins
    +    gsW=  #$25F1;                       // ◱ ECMA the same
    +    gsB=  #$25b5;                       // ▵
    +    gs=   gsW;
    +    rsW=  #$25F2;                       // ◲ ECMA the same
    +    rsB=  #$25c3;                       // ◃
    +    rs=   rsW;
    +    usW=  #$25F3;                       // ◳ ECMA the same
    +    usB=  #$25b9;                       // ▹
    +    us=   usW;
    +    del=  #$2425;                       // ␥
    +    bar=  #$033c;                       // ̼'
    +
    +(* Not represented above is a Burroughs glyph for ETX, which in the material    *)
    +(* available to me appears indistinguisable from CAN. If anybody has variant    *)
    +(* glyphs from other manufacturers please contribute.                           *)
    +
    +  var
    +    i, test, masked: integer;
    +
    +  begin
    +    result := str;
    +
    +  (* This should probably be recoded to use a persistent table, but doing it    *)
    +  (* this way results in no lookup for plain text which is likely to be the     *)
    +  (* bulk of the output. I'm not making any assumptions about the Unicode       *)
    +  (* characters being sequential so that this code can be used both for control *)
    +  (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
    +  (* want to adjust them she can do so.                                         *)
    +
    +    for i := Length(result) downto 1 do begin
    +      test := Ord(result[i]);
    +      if c1Underbar then
    +        masked := test and $7f          (* Handle both C0 and C1 in one operation *)
    +      else
    +        masked := test;
    +      case masked of
    +        $00: result[i] := nul;
    +        $01: result[i] := soh;
    +        $02: result[i] := stx;
    +        $03: result[i] := etx;
    +        $04: result[i] := eot;
    +        $05: result[i] := enq;
    +        $06: result[i] := ack;
    +        $07: result[i] := bel;
    +        $08: result[i] := bs;
    +        $09: result[i] := ht;
    +        $0a: result[i] := lf;
    +        $0b: result[i] := vt;
    +        $0c: result[i] := ff;
    +        $0d: result[i] := cr;
    +        $0e: result[i] := so;
    +        $0f: result[i] := si;
    +        $10: result[i] := dle;
    +        $11: result[i] := dc1;
    +        $12: result[i] := dc2;
    +        $13: result[i] := dc3;
    +        $14: result[i] := dc4;
    +        $15: result[i] := nak;
    +        $16: result[i] := syn;
    +        $17: result[i] := etb;
    +        $18: result[i] := can;
    +        $19: result[i] := em;
    +        $1a: result[i] := sub;
    +        $1b: result[i] := esc;
    +        $1c: result[i] := fs;
    +        $1d: result[i] := gs;
    +        $1e: result[i] := rs;
    +        $1f: result[i] := us;
    +        $7f: result[i] := del
    +      otherwise
    +      end;
    +      if c1Underbar and                 (* Now fix changed C1 characters        *)
    +                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
    +                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
    +        Insert(bar, result, i + 1)
    +    end
    +  end { withIso2047 } ;
    +
    +
    +  (* Look at the line index cl in a TStringList. Assume that at the start there
    +    will be a line number and padding occupying nl characters, after that will
    +    be text. Convert the text to hex possibly inserting extra lines after the
    +    one being processed, only the first (i.e. original) line has a line number.
    +  *)
    +  procedure expandAsHex(var stringList: TStringList; currentLine, lineNumberLength: integer);
    +
    +  var
    +    lineNumberAsText,     scratch     : string;
    +    dataAsByteArray: TBytes;
    +    lengthLastBlock, startLastBlock: integer;
    +
    +
    +    (* Recursively process the byte array from the end to the beginning. All
    +      lines are inserted immediately after the original current line, except for
    +      the final line processed which overwrites the original.
    +    *)
    +    procedure hexLines(start, bytes: integer);
    +
    +
    +      (* The parameter is a line number as text or an equivalent run of spaces.
    +        The result is a line of hex + ASCII data.
    +      *)
    +      function oneHexLine(const lineNum: string): widestring;
    +
    +      var
    +        i: integer;
    +
    +      begin
    +        result := lineNum;
    +        for i := 0 to 15 do
    +          if i < bytes then
    +            result += LowerCase(HexStr(dataAsByteArray[start + i], 2)) + ' '
    +          else
    +            result += '   ';
    +        result += ' ';                  (* Between hex and ASCII                *)
    +        for i := 0 to 15 do
    +          if i < bytes then
    +            case dataAsByteArray[start + i] of
    +              $20..$7e: result += Chr(dataAsByteArray[start + i])
    +            otherwise
    +              result += #$00B7          // ·
    +            end
    +      end { oneHexLine } ;
    +
    +
    +    begin
    +      if start = 0 then
    +        stringList[currentLine] := oneHexLine(lineNumberAsText)
    +      else begin
    +        stringList.insert(currentLine + 1, oneHexLine(PadLeft('', Length(lineNumberAsText))));
    +        hexLines(start - 16, 16)
    +      end
    +    end { hexLines } ;
    +
    +
    +  begin
    +    if lineNumberLength = 0 then begin
    +      lineNumberAsText := '';
    +      dataAsByteArray := BytesOf(Copy(stringList[currentLine], 1,
    +                                Length(stringList[currentLine])))
    +    end else begin                      (* Remember one extra space after number *)
    +      lineNumberAsText := Copy(stringList[currentLine], 1, lineNumberLength + 1);
    +      dataAsByteArray := BytesOf(Copy(stringList[currentLine], lineNumberLength + 2,
    +                                Length(stringList[currentLine]) - (lineNumberLength + 1)))
    +    end;
    +    lengthLastBlock := Length(dataAsByteArray) mod 16;
    +    startLastBlock := Length(dataAsByteArray) - lengthLastBlock;
    +    hexLines(startLastBlock, lengthLastBlock)
    +  end { expandAsHex } ;
    +
    +
     begin
       if ttyHandle = handleUnopened then begin (* Do this at first output only      *)
         //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.AddOutput Calling consoleSizeChanged']);
         consoleSizeChanged
       end;
    -  while Memo1.Lines.Count > 5000 do
    +
    +(* Get the maximum number of lines to be displayed from the user interface,     *)
    +(* work out how much space is needed to display a line number, and if necessary *)
    +(* trim the amount of currently-stored text.                                    *)
    +
    +  try
    +    lineLimit := StrToInt(Trim(MaskEdit1.Text))
    +  except
    +    MaskEdit1.Text := '5000';
    +    lineLimit := 5000
    +  end;
    +  if CheckGroupRight.Checked[0] then    (* Line numbers?                        *)
    +    case lineLimit + fFirstLine - 1 of
    +      0..999:          numLength := 3;
    +      1000..99999:     numLength := 5;
    +      100000..9999999: numLength := 7
    +    otherwise
    +      numLength := 9
    +    end
    +  else
    +    numLength := 0;
    +  while Memo1.Lines.Count > lineLimit do
         Memo1.Lines.Delete(0);
     
    -// Working note: make any adjustment to the number of lines etc. before we
    -// start to add text which might include escape handling.
    +(* Use an intermediate buffer to process the line or potentially lines of text  *)
    +(* passed as the parameter; where formatting as hex breaks it up into multiple  *)
    +(* lines, the line number is blanked on the synthetic ones. When lines or lists *)
    +(* of lines are processed in reverse it is because an indeterminate number of   *)
    +(* insertions (e.g. Unicode combining diacritics or extended hex output) may be *)
    +(* inserted after the current index.                                            *)
    +(*                                                                              *)
    +(* This might look like a bit of a palaver, but a standard memo might exhibit   *)
    +(* "interesting" behavior once the amount of text causes it to start scrolling  *)
    +(* so having an intermediate that can be inspected might be useful.             *)
     
    -  Memo1.Text:=Memo1.Text+AText;
    -  Memo1.SelStart := length(Memo1.Text);
    -end;
    +  buffer := TStringList.Create;
    +  try
    +    buffer.Text := AText;     (* Decides what line breaks it wants to swallow   *)
    +    if buffer.Count = 1 then
    +      i := 12345              (* Good place for a breakpoint                    *)
    +    else
    +      i := 67890;             (* Another good place for a breakpoint            *)
    +    case RadioGroupRight.ItemIndex of
    +      1: for i := 0 to buffer.Count - 1 do
    +           buffer[i] := withControlPictures(buffer[i], CheckGroupRight.Checked[1]);
    +      2: for i := 0 to buffer.Count - 1 do
    +           buffer[i] := withIso2047(buffer[i], CheckGroupRight.Checked[1])
    +    otherwise
    +    end;
    +    for i := 0 to buffer.Count - 1 do begin             (* Line numbers         *)
    +      if numLength > 0 then
    +        buffer[i] := PadLeft(IntToStr(fFirstLine), numLength) + ' ' + buffer[i];
    +      fFirstLine += 1
    +    end;
    +    if RadioGroupRight.ItemIndex = 3 then (* Expand hex line-by-line in reverse *)
    +      for i := buffer.Count - 1 downto 0 do
    +        expandAsHex(buffer, i, numLength);
     
    +(* Add the buffered text to the visible control(s), and clean up.               *)
    +
    +    Memo1.Lines.AddStrings(buffer)
    +  finally
    +    buffer.Free
    +  end;
    +  Memo1.SelStart := length(Memo1.Text)
    +end { TPseudoConsoleDlg.AddOutput } ;
    +
    +
     procedure TPseudoConsoleDlg.Clear;
    +
     begin
       //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.Clear Calling FormResize']);
       FormResize(nil);                      (* Safe during IDE initialisation       *)
       Memo1.Text := '';
    -end;
    +  fFirstLine := 1
    +end { TPseudoConsoleDlg.Clear } ;
     
    +
     {$R *.lfm}
     
     initialization
    Index: debugger/test/testconsolescroll.lpi
    ===================================================================
    --- debugger/test/testconsolescroll.lpi	(nonexistent)
    +++ debugger/test/testconsolescroll.lpi	(working copy)
    @@ -0,0 +1,53 @@
    +<?xml version="1.0" encoding="UTF-8"?>
    +<CONFIG>
    +  <ProjectOptions>
    +    <Version Value="11"/>
    +    <General>
    +      <Flags>
    +        <MainUnitHasCreateFormStatements Value="False"/>
    +        <MainUnitHasScaledStatement Value="False"/>
    +      </Flags>
    +      <SessionStorage Value="InProjectDir"/>
    +      <MainUnit Value="0"/>
    +      <Title Value="My Application"/>
    +      <UseAppBundle Value="False"/>
    +      <ResourceType Value="res"/>
    +    </General>
    +    <BuildModes Count="1">
    +      <Item1 Name="Default" Default="True"/>
    +    </BuildModes>
    +    <PublishOptions>
    +      <Version Value="2"/>
    +    </PublishOptions>
    +    <RunParams>
    +      <FormatVersion Value="2"/>
    +      <Modes Count="0"/>
    +    </RunParams>
    +    <Units Count="1">
    +      <Unit0>
    +        <Filename Value="testconsolescroll.pas"/>
    +        <IsPartOfProject Value="True"/>
    +        <UnitName Value="TestConsoleScroll"/>
    +      </Unit0>
    +    </Units>
    +  </ProjectOptions>
    +  <CompilerOptions>
    +    <Version Value="11"/>
    +    <Target>
    +      <Filename Value="testconsolescroll"/>
    +    </Target>
    +    <SearchPaths>
    +      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    +    </SearchPaths>
    +  </CompilerOptions>
    +  <Debugging>
    +    <Exceptions Count="2">
    +      <Item1>
    +        <Name Value="EAbort"/>
    +      </Item1>
    +      <Item2>
    +        <Name Value="ECodetoolError"/>
    +      </Item2>
    +    </Exceptions>
    +  </Debugging>
    +</CONFIG>
    Index: debugger/test/testconsolescroll.pas
    ===================================================================
    --- debugger/test/testconsolescroll.pas	(nonexistent)
    +++ debugger/test/testconsolescroll.pas	(working copy)
    @@ -0,0 +1,27 @@
    +program TestConsoleScroll;
    +
    +(* This console-mode program for Linux or other unix implementations outputs	*)
    +(* 100 numbered lines, followed by all 256 8-bit characters as a block. The	*)
    +(* lines should be presented without intervening blanks, the character block	*)
    +(* should make sense provided that a formatted console style is selected.	*)
    +(*										*)
    +(* It DOES NOT attempt any formatted output using escape sequences etc. MarkMLl	*)
    +
    +uses
    +  SysUtils;
    +
    +var
    +  i, j: integer;
    +
    +begin
    +  for i := 1 to 100 do
    +    WriteLn(i);
    +  WriteLn;
    +  for i := 0 to 15 do begin
    +    for j := 1 to 15 do
    +      Write(Chr(16 * i + j));
    +    WriteLn
    +  end;
    +  WriteLn 
    +end.
    +  
    Index: debugger/test/watchconsolesize.pas
    ===================================================================
    --- debugger/test/watchconsolesize.pas	(revision 58484)
    +++ debugger/test/watchconsolesize.pas	(working copy)
    @@ -53,6 +53,8 @@
     
     
     begin
    +  WriteLn('This header line comprises 50 characters plus EOL.');
    +  WriteLn;
       WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
       reportSize;
       if not hookWinch() then
    Index: ide/lazarus.lpi
    ===================================================================
    --- ide/lazarus.lpi	(revision 58484)
    +++ ide/lazarus.lpi	(working copy)
    @@ -1429,10 +1429,10 @@
           <OtherUnitFiles Value="frames;../converter;../debugger;../debugger/frames;../packager;../designer;../packager/frames;../ide"/>
           <UnitOutputDirectory Value="$(LazarusDir)/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
         </SearchPaths>
    -    <CompileReasons Compile="False" Build="False" Run="False"/>
    +    <CompileReasons Run="False"/>
       </CompilerOptions>
       <Debugging>
    -    <Exceptions Count="2">
    +    <Exceptions Count="3">
           <Item1>
             <Name Value="EAbort"/>
           </Item1>
    @@ -1439,6 +1439,9 @@
           <Item2>
             <Name Value="ECodetoolError"/>
           </Item2>
    +      <Item3>
    +        <Name Value="EReadError"/>
    +      </Item3>
         </Exceptions>
       </Debugging>
     </CONFIG>
    Index: ide/lazarus.res
    ===================================================================
    Cannot display: file marked as a binary type.
    svn:mime-type = application/octet-stream
    
  • debug-console-unformatted-new.patch (15,550 bytes)
    Index: debugger/pseudoterminaldlg.lfm
    ===================================================================
    --- debugger/pseudoterminaldlg.lfm	(revision 58501)
    +++ debugger/pseudoterminaldlg.lfm	(working copy)
    @@ -1,24 +1,210 @@
     object PseudoConsoleDlg: TPseudoConsoleDlg
    -  Left = 697
    -  Height = 240
    -  Top = 327
    -  Width = 320
    +  Left = 438
    +  Height = 480
    +  Top = 321
    +  Width = 800
       Caption = 'Console'
    -  ClientHeight = 240
    -  ClientWidth = 320
    +  ClientHeight = 480
    +  ClientWidth = 800
       DockSite = True
       OnResize = FormResize
       LCLVersion = '1.9.0.0'
    -  object Memo1: TMemo
    +  object PageControl1: TPageControl
         Left = 0
    -    Height = 240
    +    Height = 460
         Top = 0
    -    Width = 320
    +    Width = 800
    +    ActivePage = TabSheetRaw
         Align = alClient
    -    OnUTF8KeyPress = Memo1UTF8KeyPress
    -    ReadOnly = True
    -    ScrollBars = ssAutoBoth
    +    TabIndex = 1
         TabOrder = 0
    -    WantTabs = True
    +    object TabSheet1: TTabSheet
    +      Caption = 'Formatted'
    +      ClientHeight = 430
    +      ClientWidth = 790
    +      TabVisible = False
    +      object Panel1: TPanel
    +        Left = 470
    +        Height = 430
    +        Top = 0
    +        Width = 160
    +        Align = alRight
    +        Caption = 'Panel1'
    +        TabOrder = 0
    +      end
    +    end
    +    object TabSheetRaw: TTabSheet
    +      Caption = 'Raw Output'
    +      ClientHeight = 430
    +      ClientWidth = 790
    +      object PairSplitterRaw: TPairSplitter
    +        Left = 0
    +        Height = 430
    +        Top = 0
    +        Width = 790
    +        Align = alClient
    +        Position = 600
    +        object PairSplitterRawLeft: TPairSplitterSide
    +          Cursor = crArrow
    +          Left = 0
    +          Height = 430
    +          Top = 0
    +          Width = 600
    +          ClientWidth = 600
    +          ClientHeight = 430
    +          object Memo1: TMemo
    +            Left = 4
    +            Height = 422
    +            Top = 4
    +            Width = 592
    +            Align = alClient
    +            BorderSpacing.Around = 4
    +            Font.Name = 'Monospace'
    +            OnUTF8KeyPress = Memo1UTF8KeyPress
    +            ParentFont = False
    +            ReadOnly = True
    +            ScrollBars = ssAutoBoth
    +            TabOrder = 0
    +            WantTabs = True
    +          end
    +        end
    +        object PairSplitterRawRight: TPairSplitterSide
    +          Cursor = crArrow
    +          Left = 605
    +          Height = 430
    +          Top = 0
    +          Width = 185
    +          ClientWidth = 185
    +          ClientHeight = 430
    +          OnResize = PairSplitterRawRightResize
    +          object RadioGroupRight: TRadioGroup
    +            Left = 0
    +            Height = 103
    +            Top = 0
    +            Width = 185
    +            Align = alTop
    +            AutoFill = True
    +            AutoSize = True
    +            Caption = 'Output Style'
    +            ChildSizing.LeftRightSpacing = 6
    +            ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
    +            ChildSizing.EnlargeVertical = crsHomogenousChildResize
    +            ChildSizing.ShrinkHorizontal = crsScaleChilds
    +            ChildSizing.ShrinkVertical = crsScaleChilds
    +            ChildSizing.Layout = cclLeftToRightThenTopToBottom
    +            ChildSizing.ControlsPerLine = 1
    +            ClientHeight = 84
    +            ClientWidth = 183
    +            ItemIndex = 0
    +            Items.Strings = (
    +              'Unformatted'
    +              'C0 as Control Pictures'
    +              'C0 as ISO 2047'
    +              'Hex + ASCII'
    +            )
    +            OnSelectionChanged = RadioGroupRightSelectionChanged
    +            TabOrder = 1
    +          end
    +          object PanelRightBelowRG: TPanel
    +            Left = 0
    +            Height = 327
    +            Top = 103
    +            Width = 185
    +            Align = alClient
    +            BevelOuter = bvNone
    +            ClientHeight = 327
    +            ClientWidth = 185
    +            TabOrder = 0
    +            object CheckGroupRight: TCheckGroup
    +              Left = 0
    +              Height = 73
    +              Top = 0
    +              Width = 185
    +              Align = alTop
    +              AutoFill = True
    +              AutoSize = True
    +              Caption = 'Decorations'
    +              ChildSizing.LeftRightSpacing = 6
    +              ChildSizing.TopBottomSpacing = 6
    +              ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
    +              ChildSizing.EnlargeVertical = crsHomogenousChildResize
    +              ChildSizing.ShrinkHorizontal = crsScaleChilds
    +              ChildSizing.ShrinkVertical = crsScaleChilds
    +              ChildSizing.Layout = cclLeftToRightThenTopToBottom
    +              ChildSizing.ControlsPerLine = 1
    +              ClientHeight = 54
    +              ClientWidth = 183
    +              Enabled = False
    +              Items.Strings = (
    +                'Line numbers'
    +                'C1 as C0 + Underbar'
    +              )
    +              TabOrder = 1
    +              Data = {
    +                020000000202
    +              }
    +            end
    +            object PanelRightBelowCG: TPanel
    +              Left = 0
    +              Height = 254
    +              Top = 73
    +              Width = 185
    +              Align = alClient
    +              BevelOuter = bvNone
    +              ClientHeight = 254
    +              ClientWidth = 185
    +              TabOrder = 0
    +              object GroupBoxRight: TGroupBox
    +                Left = 0
    +                Height = 64
    +                Top = 0
    +                Width = 185
    +                Align = alTop
    +                Caption = 'Line limit'
    +                ClientHeight = 45
    +                ClientWidth = 183
    +                TabOrder = 0
    +                object MaskEdit1: TMaskEdit
    +                  Left = 9
    +                  Height = 30
    +                  Top = 0
    +                  Width = 128
    +                  CharCase = ecNormal
    +                  MaxLength = 7
    +                  TabOrder = 0
    +                  EditMask = '#######'
    +                  Text = '5000   '
    +                  SpaceChar = '_'
    +                end
    +              end
    +            end
    +          end
    +        end
    +      end
    +    end
       end
    +  object StatusBar1: TStatusBar
    +    Left = 0
    +    Height = 20
    +    Top = 460
    +    Width = 800
    +    Panels = <    
    +      item
    +        Text = '    dumb'
    +        Width = 160
    +      end    
    +      item
    +        Text = '00 x 00 chars'
    +        Width = 160
    +      end    
    +      item
    +        Text = '000 x 000 pixels'
    +        Width = 160
    +      end    
    +      item
    +        Text = 'Not resized'
    +        Width = 160
    +      end>
    +    SimplePanel = False
    +  end
     end
    Index: debugger/pseudoterminaldlg.pp
    ===================================================================
    --- debugger/pseudoterminaldlg.pp	(revision 58501)
    +++ debugger/pseudoterminaldlg.pp	(working copy)
    @@ -35,8 +35,9 @@
     interface
     
     uses
    -  IDEWindowIntf, Classes, Graphics,
    -  Forms, StdCtrls, DebuggerDlg, BaseDebugManager, LazarusIDEStrConsts, LCLType;
    +  IDEWindowIntf, Classes, Graphics, Forms, StdCtrls, DebuggerDlg,
    +  BaseDebugManager, LazarusIDEStrConsts, LCLType, ComCtrls, ExtCtrls, MaskEdit,
    +  PairSplitter;
     
     type
     
    @@ -43,9 +44,25 @@
       { TPseudoConsoleDlg }
     
       TPseudoConsoleDlg = class(TDebuggerDlg)
    +    CheckGroupRight: TCheckGroup;
    +    GroupBoxRight: TGroupBox;
    +    MaskEdit1: TMaskEdit;
         Memo1: TMemo;
    +    PageControl1: TPageControl;
    +    PairSplitterRaw: TPairSplitter;
    +    PairSplitterRawLeft: TPairSplitterSide;
    +    PairSplitterRawRight: TPairSplitterSide;
    +    Panel1: TPanel;
    +    PanelRightBelowRG: TPanel;
    +    PanelRightBelowCG: TPanel;
    +    RadioGroupRight: TRadioGroup;
    +    StatusBar1: TStatusBar;
    +    TabSheet1: TTabSheet;
    +    TabSheetRaw: TTabSheet;
         procedure FormResize(Sender: TObject);
         procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
    +    procedure PairSplitterRawRightResize(Sender: TObject);
    +    procedure RadioGroupRightSelectionChanged(Sender: TObject);
       private
         { private declarations }
         ttyHandle: System.THandle;         (* Used only by unix for console size tracking  *)
    @@ -53,6 +70,7 @@
         fCharWidth: word;
         fRowsPerScreen: integer;
         fColsPerRow: integer;
    +    fFirstLine: integer;
         procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
         procedure consoleSizeChanged;
       protected
    @@ -75,7 +93,7 @@
     implementation
     
     uses
    -  SysUtils, LazLoggerBase
    +  SysUtils, StrUtils, LazLoggerBase
     {$IFDEF DBG_ENABLE_TERMINAL}
       , Unix, BaseUnix, termio
     {$ENDIF DBG_ENABLE_TERMINAL}
    @@ -98,6 +116,50 @@
     end;
     
     
    +procedure TPseudoConsoleDlg.PairSplitterRawRightResize(Sender: TObject);
    +
    +var
    +  ttyNotYetInitialised: boolean;
    +
    +begin
    +
    +(* These are not errors so much as conditions we will see while the IDE is      *)
    +(* starting up.                                                                 *)
    +
    +  if DebugBoss = nil then
    +    exit;
    +  if DebugBoss.PseudoTerminal = nil then
    +    exit;
    +
    +(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
    +(* so while we prefer success we also consider that failure /is/ an acceptable  *)
    +(* option in this case.                                                         *)
    +
    +  ttyNotYetInitialised := ttyHandle = handleUnopened;
    +  //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.SplitterRawRightResize Calling consoleSizeChanged']);
    +  consoleSizeChanged;
    +  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
    +    DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.SplitterRawRightResize Bad PseudoTerminal -> unopened']);
    +    ttyHandle := handleUnopened
    +  end;
    +  StatusBar1.Panels[3].Text := 'Splitter resized'
    +end { TPseudoConsoleDlg.PairSplitterRawRightResize } ;
    +
    +
    +(* The C1 underbar decoration is only relevant when C0 is being displayed as
    +  control pictures or ISO 2047 glyphs.
    +*)
    +procedure TPseudoConsoleDlg.RadioGroupRightSelectionChanged(Sender: TObject);
    +
    +begin
    +  case RadioGroupRight.ItemIndex of
    +    1, 2: CheckGroupRight.CheckEnabled[1] := true
    +  otherwise
    +    CheckGroupRight.CheckEnabled[1] := false
    +  end
    +end { TPseudoConsoleDlg.RadioGroupRightSelectionChanged } ;
    +
    +
     (* The form size has changed. Call a procedure to pass this to the kernel etc.,
       assuming that this works out the best control to track.
     *)
    @@ -126,8 +188,9 @@
       if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
         DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
         ttyHandle := handleUnopened
    -  end
    -end;
    +  end;
    +  StatusBar1.Panels[3].Text := 'Window resized'
    +end { TPseudoConsoleDlg.FormResize } ;
     
     
     procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
    @@ -140,8 +203,9 @@
     {$ENDIF DBG_ENABLE_TERMINAL}
       inherited DoClose(CloseAction);
       CloseAction := caHide;
    -end;
    +end { TPseudoConsoleDlg.DoClose } ;
     
    +
     constructor TPseudoConsoleDlg.Create(TheOwner: TComponent);
     begin
       inherited Create(TheOwner);
    @@ -149,8 +213,9 @@
       Caption:= lisDbgTerminal;
       ttyHandle := handleUnopened;
       fRowsPerScreen := -1;
    -  fColsPerRow := -1
    -end;
    +  fColsPerRow := -1;
    +  fFirstLine := 1
    +end { TPseudoConsoleDlg.Create } ;
     
     
     (* Get the height and width for characters described by the fount specified by
    @@ -173,7 +238,7 @@
       finally
         bm.Free
       end
    -end;
    +end { TPseudoConsoleDlg.getCharHeightAndWidth } ;
     
     
     (* Assume that the console size has changed, either because it's just starting
    @@ -275,8 +340,19 @@
     begin
       ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
     {$ENDIF DBG_ENABLE_TERMINAL }
    -  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
    -end;
    +  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit');
    +  RadioGroupRightSelectionChanged(nil); (* Sort out initial state               *)
    +  StatusBar1.Panels[0].Width := Width div 4;
    +  StatusBar1.Panels[0].Text := '    ' ; // + DebugBoss.Debugger.Environment.Values['TERM'];
    +  StatusBar1.Panels[1].Width := Width div 4;
    +{$IFDEF DBG_ENABLE_TERMINAL }
    +  StatusBar1.Panels[1].Text := Format('%d cols x %d rows', [winsize.ws_col, winsize.ws_row]);
    +{$ENDIF DBG_ENABLE_TERMINAL }
    +  StatusBar1.Panels[2].Width := Width div 4;
    +{$IFDEF DBG_ENABLE_TERMINAL }
    +  StatusBar1.Panels[2].Text := Format('%d x %d pixels', [winsize.ws_xpixel, winsize.ws_ypixel])
    +{$ENDIF DBG_ENABLE_TERMINAL }
    +end { TPseudoConsoleDlg.consoleSizeChanged } ;
     
     
     procedure TPseudoConsoleDlg.AddOutput(const AText: String);
    Index: debugger/test/testconsolescroll.lpi
    ===================================================================
    --- debugger/test/testconsolescroll.lpi	(nonexistent)
    +++ debugger/test/testconsolescroll.lpi	(working copy)
    @@ -0,0 +1,53 @@
    +<?xml version="1.0" encoding="UTF-8"?>
    +<CONFIG>
    +  <ProjectOptions>
    +    <Version Value="11"/>
    +    <General>
    +      <Flags>
    +        <MainUnitHasCreateFormStatements Value="False"/>
    +        <MainUnitHasScaledStatement Value="False"/>
    +      </Flags>
    +      <SessionStorage Value="InProjectDir"/>
    +      <MainUnit Value="0"/>
    +      <Title Value="My Application"/>
    +      <UseAppBundle Value="False"/>
    +      <ResourceType Value="res"/>
    +    </General>
    +    <BuildModes Count="1">
    +      <Item1 Name="Default" Default="True"/>
    +    </BuildModes>
    +    <PublishOptions>
    +      <Version Value="2"/>
    +    </PublishOptions>
    +    <RunParams>
    +      <FormatVersion Value="2"/>
    +      <Modes Count="0"/>
    +    </RunParams>
    +    <Units Count="1">
    +      <Unit0>
    +        <Filename Value="testconsolescroll.pas"/>
    +        <IsPartOfProject Value="True"/>
    +        <UnitName Value="TestConsoleScroll"/>
    +      </Unit0>
    +    </Units>
    +  </ProjectOptions>
    +  <CompilerOptions>
    +    <Version Value="11"/>
    +    <Target>
    +      <Filename Value="testconsolescroll"/>
    +    </Target>
    +    <SearchPaths>
    +      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    +    </SearchPaths>
    +  </CompilerOptions>
    +  <Debugging>
    +    <Exceptions Count="2">
    +      <Item1>
    +        <Name Value="EAbort"/>
    +      </Item1>
    +      <Item2>
    +        <Name Value="ECodetoolError"/>
    +      </Item2>
    +    </Exceptions>
    +  </Debugging>
    +</CONFIG>
    Index: debugger/test/testconsolescroll.pas
    ===================================================================
    --- debugger/test/testconsolescroll.pas	(nonexistent)
    +++ debugger/test/testconsolescroll.pas	(working copy)
    @@ -0,0 +1,27 @@
    +program TestConsoleScroll;
    +
    +(* This console-mode program for Linux or other unix implementations outputs	*)
    +(* 100 numbered lines, followed by all 256 8-bit characters as a block. The	*)
    +(* lines should be presented without intervening blanks, the character block	*)
    +(* should make sense provided that a formatted console style is selected.	*)
    +(*										*)
    +(* It DOES NOT attempt any formatted output using escape sequences etc. MarkMLl	*)
    +
    +uses
    +  SysUtils;
    +
    +var
    +  i, j: integer;
    +
    +begin
    +  for i := 1 to 100 do
    +    WriteLn(i);
    +  WriteLn;
    +  for i := 0 to 15 do begin
    +    for j := 1 to 15 do
    +      Write(Chr(16 * i + j));
    +    WriteLn
    +  end;
    +  WriteLn 
    +end.
    +  
    Index: debugger/test/watchconsolesize.pas
    ===================================================================
    --- debugger/test/watchconsolesize.pas	(revision 58501)
    +++ debugger/test/watchconsolesize.pas	(working copy)
    @@ -53,6 +53,8 @@
     
     
     begin
    +  WriteLn('This header line comprises 50 characters plus EOL.');
    +  WriteLn;
       WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
       reportSize;
       if not hookWinch() then
    
  • debug-console-unformatted-new2.patch (14,103 bytes)
    Index: debugger/pseudoterminaldlg.lfm
    ===================================================================
    --- debugger/pseudoterminaldlg.lfm	(revision 58530)
    +++ debugger/pseudoterminaldlg.lfm	(working copy)
    @@ -1,24 +1,212 @@
     object PseudoConsoleDlg: TPseudoConsoleDlg
    -  Left = 697
    -  Height = 240
    -  Top = 327
    -  Width = 320
    +  Left = 438
    +  Height = 480
    +  Top = 321
    +  Width = 800
       Caption = 'Console'
    -  ClientHeight = 240
    -  ClientWidth = 320
    +  ClientHeight = 480
    +  ClientWidth = 800
       DockSite = True
       OnResize = FormResize
       LCLVersion = '1.9.0.0'
    -  object Memo1: TMemo
    +  object PageControl1: TPageControl
         Left = 0
    -    Height = 240
    +    Height = 460
         Top = 0
    -    Width = 320
    +    Width = 800
    +    ActivePage = TabSheetRaw
         Align = alClient
    -    OnUTF8KeyPress = Memo1UTF8KeyPress
    -    ReadOnly = True
    -    ScrollBars = ssAutoBoth
    +    TabIndex = 1
         TabOrder = 0
    -    WantTabs = True
    +    object TabSheet1: TTabSheet
    +      Caption = 'Formatted'
    +      ClientHeight = 430
    +      ClientWidth = 790
    +      TabVisible = False
    +      object Panel1: TPanel
    +        Left = 470
    +        Height = 430
    +        Top = 0
    +        Width = 160
    +        Align = alRight
    +        Caption = 'Panel1'
    +        TabOrder = 0
    +      end
    +    end
    +    object TabSheetRaw: TTabSheet
    +      Caption = 'Raw Output'
    +      ClientHeight = 430
    +      ClientWidth = 790
    +      object PairSplitterRaw: TPairSplitter
    +        Left = 0
    +        Height = 430
    +        Top = 0
    +        Width = 790
    +        Align = alClient
    +        Position = 600
    +        object PairSplitterRawLeft: TPairSplitterSide
    +          Cursor = crArrow
    +          Left = 0
    +          Height = 430
    +          Top = 0
    +          Width = 600
    +          ClientWidth = 600
    +          ClientHeight = 430
    +          Constraints.MinWidth = 200
    +          object Memo1: TMemo
    +            Left = 4
    +            Height = 422
    +            Top = 4
    +            Width = 592
    +            Align = alClient
    +            BorderSpacing.Around = 4
    +            Font.Name = 'Monospace'
    +            OnUTF8KeyPress = Memo1UTF8KeyPress
    +            ParentFont = False
    +            ReadOnly = True
    +            ScrollBars = ssAutoBoth
    +            TabOrder = 0
    +            WantTabs = True
    +          end
    +        end
    +        object PairSplitterRawRight: TPairSplitterSide
    +          Cursor = crArrow
    +          Left = 605
    +          Height = 430
    +          Top = 0
    +          Width = 200
    +          ClientWidth = 200
    +          ClientHeight = 430
    +          Constraints.MinWidth = 200
    +          OnResize = PairSplitterRawRightResize
    +          object RadioGroupRight: TRadioGroup
    +            Left = 0
    +            Height = 103
    +            Top = 0
    +            Width = 200
    +            Align = alTop
    +            AutoFill = True
    +            AutoSize = True
    +            Caption = 'Output Style'
    +            ChildSizing.LeftRightSpacing = 6
    +            ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
    +            ChildSizing.EnlargeVertical = crsHomogenousChildResize
    +            ChildSizing.ShrinkHorizontal = crsScaleChilds
    +            ChildSizing.ShrinkVertical = crsScaleChilds
    +            ChildSizing.Layout = cclLeftToRightThenTopToBottom
    +            ChildSizing.ControlsPerLine = 1
    +            ClientHeight = 84
    +            ClientWidth = 198
    +            ItemIndex = 0
    +            Items.Strings = (
    +              'Unformatted'
    +              'C0 as Control Pictures'
    +              'C0 as ISO 2047'
    +              'Hex + ASCII'
    +            )
    +            OnSelectionChanged = RadioGroupRightSelectionChanged
    +            TabOrder = 1
    +          end
    +          object PanelRightBelowRG: TPanel
    +            Left = 0
    +            Height = 327
    +            Top = 103
    +            Width = 200
    +            Align = alClient
    +            BevelOuter = bvNone
    +            ClientHeight = 327
    +            ClientWidth = 200
    +            TabOrder = 0
    +            object CheckGroupRight: TCheckGroup
    +              Left = 0
    +              Height = 73
    +              Top = 0
    +              Width = 200
    +              Align = alTop
    +              AutoFill = True
    +              AutoSize = True
    +              Caption = 'Decorations'
    +              ChildSizing.LeftRightSpacing = 6
    +              ChildSizing.TopBottomSpacing = 6
    +              ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
    +              ChildSizing.EnlargeVertical = crsHomogenousChildResize
    +              ChildSizing.ShrinkHorizontal = crsScaleChilds
    +              ChildSizing.ShrinkVertical = crsScaleChilds
    +              ChildSizing.Layout = cclLeftToRightThenTopToBottom
    +              ChildSizing.ControlsPerLine = 1
    +              ClientHeight = 54
    +              ClientWidth = 198
    +              Enabled = False
    +              Items.Strings = (
    +                'Line numbers'
    +                'C1 as C0 + Underbar'
    +              )
    +              TabOrder = 1
    +              Data = {
    +                020000000202
    +              }
    +            end
    +            object PanelRightBelowCG: TPanel
    +              Left = 0
    +              Height = 254
    +              Top = 73
    +              Width = 200
    +              Align = alClient
    +              BevelOuter = bvNone
    +              ClientHeight = 254
    +              ClientWidth = 200
    +              TabOrder = 0
    +              object GroupBoxRight: TGroupBox
    +                Left = 0
    +                Height = 64
    +                Top = 0
    +                Width = 200
    +                Align = alTop
    +                Caption = 'Line limit'
    +                ClientHeight = 45
    +                ClientWidth = 198
    +                TabOrder = 0
    +                object MaskEdit1: TMaskEdit
    +                  Left = 9
    +                  Height = 30
    +                  Top = 0
    +                  Width = 128
    +                  CharCase = ecNormal
    +                  MaxLength = 7
    +                  TabOrder = 0
    +                  EditMask = '#######'
    +                  Text = '5000   '
    +                  SpaceChar = '_'
    +                end
    +              end
    +            end
    +          end
    +        end
    +      end
    +    end
       end
    +  object StatusBar1: TStatusBar
    +    Left = 0
    +    Height = 20
    +    Top = 460
    +    Width = 800
    +    Panels = <    
    +      item
    +        Text = '    dumb'
    +        Width = 160
    +      end    
    +      item
    +        Text = '00 x 00 chars'
    +        Width = 160
    +      end    
    +      item
    +        Text = '000 x 000 pixels'
    +        Width = 160
    +      end    
    +      item
    +        Text = 'Not resized'
    +        Width = 160
    +      end>
    +    SimplePanel = False
    +  end
     end
    Index: debugger/pseudoterminaldlg.pp
    ===================================================================
    --- debugger/pseudoterminaldlg.pp	(revision 58530)
    +++ debugger/pseudoterminaldlg.pp	(working copy)
    @@ -35,8 +35,9 @@
     interface
     
     uses
    -  IDEWindowIntf, Classes, Graphics,
    -  Forms, StdCtrls, DebuggerDlg, BaseDebugManager, LazarusIDEStrConsts, LCLType;
    +  IDEWindowIntf, Classes, Graphics, Forms, StdCtrls, DebuggerDlg,
    +  BaseDebugManager, LazarusIDEStrConsts, LCLType, ComCtrls, ExtCtrls, MaskEdit,
    +  PairSplitter;
     
     type
     
    @@ -43,9 +44,25 @@
       { TPseudoConsoleDlg }
     
       TPseudoConsoleDlg = class(TDebuggerDlg)
    +    CheckGroupRight: TCheckGroup;
    +    GroupBoxRight: TGroupBox;
    +    MaskEdit1: TMaskEdit;
         Memo1: TMemo;
    +    PageControl1: TPageControl;
    +    PairSplitterRaw: TPairSplitter;
    +    PairSplitterRawLeft: TPairSplitterSide;
    +    PairSplitterRawRight: TPairSplitterSide;
    +    Panel1: TPanel;
    +    PanelRightBelowRG: TPanel;
    +    PanelRightBelowCG: TPanel;
    +    RadioGroupRight: TRadioGroup;
    +    StatusBar1: TStatusBar;
    +    TabSheet1: TTabSheet;
    +    TabSheetRaw: TTabSheet;
         procedure FormResize(Sender: TObject);
         procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
    +    procedure PairSplitterRawRightResize(Sender: TObject);
    +    procedure RadioGroupRightSelectionChanged(Sender: TObject);
       private
         { private declarations }
         ttyHandle: System.THandle;         (* Used only by unix for console size tracking  *)
    @@ -53,6 +70,7 @@
         fCharWidth: word;
         fRowsPerScreen: integer;
         fColsPerRow: integer;
    +    fFirstLine: integer;
         procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
         procedure consoleSizeChanged;
       protected
    @@ -75,7 +93,7 @@
     implementation
     
     uses
    -  SysUtils, LazLoggerBase
    +  SysUtils, StrUtils, LazLoggerBase
     {$IFDEF DBG_ENABLE_TERMINAL}
       , Unix, BaseUnix, termio
     {$ENDIF DBG_ENABLE_TERMINAL}
    @@ -98,6 +116,50 @@
     end;
     
     
    +procedure TPseudoConsoleDlg.PairSplitterRawRightResize(Sender: TObject);
    +
    +var
    +  ttyNotYetInitialised: boolean;
    +
    +begin
    +
    +(* These are not errors so much as conditions we will see while the IDE is      *)
    +(* starting up.                                                                 *)
    +
    +  if DebugBoss = nil then
    +    exit;
    +  if DebugBoss.PseudoTerminal = nil then
    +    exit;
    +
    +(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
    +(* so while we prefer success we also consider that failure /is/ an acceptable  *)
    +(* option in this case.                                                         *)
    +
    +  ttyNotYetInitialised := ttyHandle = handleUnopened;
    +  //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.SplitterRawRightResize Calling consoleSizeChanged']);
    +  consoleSizeChanged;
    +  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
    +    DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.SplitterRawRightResize Bad PseudoTerminal -> unopened']);
    +    ttyHandle := handleUnopened
    +  end;
    +  StatusBar1.Panels[3].Text := 'Splitter resized'
    +end { TPseudoConsoleDlg.PairSplitterRawRightResize } ;
    +
    +
    +(* The C1 underbar decoration is only relevant when C0 is being displayed as
    +  control pictures or ISO 2047 glyphs.
    +*)
    +procedure TPseudoConsoleDlg.RadioGroupRightSelectionChanged(Sender: TObject);
    +
    +begin
    +  case RadioGroupRight.ItemIndex of
    +    1, 2: CheckGroupRight.CheckEnabled[1] := true
    +  otherwise
    +    CheckGroupRight.CheckEnabled[1] := false
    +  end
    +end { TPseudoConsoleDlg.RadioGroupRightSelectionChanged } ;
    +
    +
     (* The form size has changed. Call a procedure to pass this to the kernel etc.,
       assuming that this works out the best control to track.
     *)
    @@ -126,8 +188,9 @@
       if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
         DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
         ttyHandle := handleUnopened
    -  end
    -end;
    +  end;
    +  StatusBar1.Panels[3].Text := 'Window resized'
    +end { TPseudoConsoleDlg.FormResize } ;
     
     
     procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
    @@ -140,8 +203,9 @@
     {$ENDIF DBG_ENABLE_TERMINAL}
       inherited DoClose(CloseAction);
       CloseAction := caHide;
    -end;
    +end { TPseudoConsoleDlg.DoClose } ;
     
    +
     constructor TPseudoConsoleDlg.Create(TheOwner: TComponent);
     begin
       inherited Create(TheOwner);
    @@ -149,8 +213,9 @@
       Caption:= lisDbgTerminal;
       ttyHandle := handleUnopened;
       fRowsPerScreen := -1;
    -  fColsPerRow := -1
    -end;
    +  fColsPerRow := -1;
    +  fFirstLine := 1
    +end { TPseudoConsoleDlg.Create } ;
     
     
     (* Get the height and width for characters described by the fount specified by
    @@ -173,7 +238,7 @@
       finally
         bm.Free
       end
    -end;
    +end { TPseudoConsoleDlg.getCharHeightAndWidth } ;
     
     
     (* Assume that the console size has changed, either because it's just starting
    @@ -275,8 +340,19 @@
     begin
       ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
     {$ENDIF DBG_ENABLE_TERMINAL }
    -  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
    -end;
    +  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit');
    +  RadioGroupRightSelectionChanged(nil); (* Sort out initial state               *)
    +  StatusBar1.Panels[0].Width := Width div 4;
    +  StatusBar1.Panels[0].Text := '    ' ; // + DebugBoss.Debugger.Environment.Values['TERM'];
    +  StatusBar1.Panels[1].Width := Width div 4;
    +{$IFDEF DBG_ENABLE_TERMINAL }
    +  StatusBar1.Panels[1].Text := Format('%d cols x %d rows', [winsize.ws_col, winsize.ws_row]);
    +{$ENDIF DBG_ENABLE_TERMINAL }
    +  StatusBar1.Panels[2].Width := Width div 4;
    +{$IFDEF DBG_ENABLE_TERMINAL }
    +  StatusBar1.Panels[2].Text := Format('%d x %d pixels', [winsize.ws_xpixel, winsize.ws_ypixel])
    +{$ENDIF DBG_ENABLE_TERMINAL }
    +end { TPseudoConsoleDlg.consoleSizeChanged } ;
     
     
     procedure TPseudoConsoleDlg.AddOutput(const AText: String);
    @@ -286,21 +362,31 @@
         //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.AddOutput Calling consoleSizeChanged']);
         consoleSizeChanged
       end;
    -  while Memo1.Lines.Count > 5000 do
    -    Memo1.Lines.Delete(0);
    +  Memo1.Lines.BeginUpdate;
    +  try
    +    while Memo1.Lines.Count > 5000 do
    +      Memo1.Lines.Delete(0);
     
     // Working note: make any adjustment to the number of lines etc. before we
     // start to add text which might include escape handling.
     
    -  Memo1.Text:=Memo1.Text+AText;
    -  Memo1.SelStart := length(Memo1.Text);
    +    Memo1.Text:=Memo1.Text+AText;
    +    Memo1.SelStart := length(Memo1.Text)
    +  finally
    +    Memo1.Lines.BeginUpdate
    +  end
     end;
     
     procedure TPseudoConsoleDlg.Clear;
     begin
       //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.Clear Calling FormResize']);
    -  FormResize(nil);                      (* Safe during IDE initialisation       *)
    -  Memo1.Text := '';
    +  Memo1.Lines.BeginUpdate;
    +  try
    +    FormResize(nil);                    (* Safe during IDE initialisation       *)
    +    Memo1.Text := '';
    +  finally
    +    Memo1.Lines.BeginUpdate
    +  end
     end;
     
     {$R *.lfm}
    Index: debugger/test/watchconsolesize.pas
    ===================================================================
    --- debugger/test/watchconsolesize.pas	(revision 58530)
    +++ debugger/test/watchconsolesize.pas	(working copy)
    @@ -53,6 +53,8 @@
     
     
     begin
    +  WriteLn('This header line comprises 50 characters plus EOL.');
    +  WriteLn;
       WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
       reportSize;
       if not hookWinch() then
    
  • debug-console-unformatted2.diff (30,977 bytes)
    Index: debugger/pseudoterminaldlg.lfm
    ===================================================================
    --- debugger/pseudoterminaldlg.lfm	(revision 58550)
    +++ debugger/pseudoterminaldlg.lfm	(working copy)
    @@ -1,24 +1,212 @@
     object PseudoConsoleDlg: TPseudoConsoleDlg
    -  Left = 697
    -  Height = 240
    -  Top = 327
    -  Width = 320
    +  Left = 438
    +  Height = 480
    +  Top = 321
    +  Width = 800
       Caption = 'Console'
    -  ClientHeight = 240
    -  ClientWidth = 320
    +  ClientHeight = 480
    +  ClientWidth = 800
       DockSite = True
       OnResize = FormResize
       LCLVersion = '1.9.0.0'
    -  object Memo1: TMemo
    +  object PageControl1: TPageControl
         Left = 0
    -    Height = 240
    +    Height = 460
         Top = 0
    -    Width = 320
    +    Width = 800
    +    ActivePage = TabSheetRaw
         Align = alClient
    -    OnUTF8KeyPress = Memo1UTF8KeyPress
    -    ReadOnly = True
    -    ScrollBars = ssAutoBoth
    +    TabIndex = 1
         TabOrder = 0
    -    WantTabs = True
    +    object TabSheet1: TTabSheet
    +      Caption = 'Formatted'
    +      ClientHeight = 430
    +      ClientWidth = 790
    +      TabVisible = False
    +      object Panel1: TPanel
    +        Left = 470
    +        Height = 430
    +        Top = 0
    +        Width = 160
    +        Align = alRight
    +        Caption = 'Panel1'
    +        TabOrder = 0
    +      end
    +    end
    +    object TabSheetRaw: TTabSheet
    +      Caption = 'Raw Output'
    +      ClientHeight = 430
    +      ClientWidth = 790
    +      object PairSplitterRaw: TPairSplitter
    +        Left = 0
    +        Height = 430
    +        Top = 0
    +        Width = 790
    +        Align = alClient
    +        Position = 600
    +        object PairSplitterRawLeft: TPairSplitterSide
    +          Cursor = crArrow
    +          Left = 0
    +          Height = 430
    +          Top = 0
    +          Width = 600
    +          ClientWidth = 600
    +          ClientHeight = 430
    +          Constraints.MinWidth = 200
    +          object Memo1: TMemo
    +            Left = 4
    +            Height = 422
    +            Top = 4
    +            Width = 592
    +            Align = alClient
    +            BorderSpacing.Around = 4
    +            Font.Name = 'Monospace'
    +            OnUTF8KeyPress = Memo1UTF8KeyPress
    +            ParentFont = False
    +            ReadOnly = True
    +            ScrollBars = ssAutoBoth
    +            TabOrder = 0
    +            WantTabs = True
    +          end
    +        end
    +        object PairSplitterRawRight: TPairSplitterSide
    +          Cursor = crArrow
    +          Left = 605
    +          Height = 430
    +          Top = 0
    +          Width = 200
    +          ClientWidth = 200
    +          ClientHeight = 430
    +          Constraints.MinWidth = 200
    +          OnResize = PairSplitterRawRightResize
    +          object RadioGroupRight: TRadioGroup
    +            Left = 0
    +            Height = 103
    +            Top = 0
    +            Width = 200
    +            Align = alTop
    +            AutoFill = True
    +            AutoSize = True
    +            Caption = 'Output Style'
    +            ChildSizing.LeftRightSpacing = 6
    +            ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
    +            ChildSizing.EnlargeVertical = crsHomogenousChildResize
    +            ChildSizing.ShrinkHorizontal = crsScaleChilds
    +            ChildSizing.ShrinkVertical = crsScaleChilds
    +            ChildSizing.Layout = cclLeftToRightThenTopToBottom
    +            ChildSizing.ControlsPerLine = 1
    +            ClientHeight = 84
    +            ClientWidth = 198
    +            ItemIndex = 0
    +            Items.Strings = (
    +              'Unformatted'
    +              'C0 as Control Pictures'
    +              'C0 as ISO 2047'
    +              'Hex + ASCII'
    +            )
    +            OnSelectionChanged = RadioGroupRightSelectionChanged
    +            TabOrder = 1
    +          end
    +          object PanelRightBelowRG: TPanel
    +            Left = 0
    +            Height = 327
    +            Top = 103
    +            Width = 200
    +            Align = alClient
    +            BevelOuter = bvNone
    +            ClientHeight = 327
    +            ClientWidth = 200
    +            TabOrder = 0
    +            object CheckGroupRight: TCheckGroup
    +              Left = 0
    +              Height = 73
    +              Top = 0
    +              Width = 200
    +              Align = alTop
    +              AutoFill = True
    +              AutoSize = True
    +              Caption = 'Decorations'
    +              ChildSizing.LeftRightSpacing = 6
    +              ChildSizing.TopBottomSpacing = 6
    +              ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
    +              ChildSizing.EnlargeVertical = crsHomogenousChildResize
    +              ChildSizing.ShrinkHorizontal = crsScaleChilds
    +              ChildSizing.ShrinkVertical = crsScaleChilds
    +              ChildSizing.Layout = cclLeftToRightThenTopToBottom
    +              ChildSizing.ControlsPerLine = 1
    +              ClientHeight = 54
    +              ClientWidth = 198
    +              Enabled = False
    +              Items.Strings = (
    +                'Line numbers'
    +                'C1 as C0 + Underbar'
    +              )
    +              TabOrder = 1
    +              Data = {
    +                020000000202
    +              }
    +            end
    +            object PanelRightBelowCG: TPanel
    +              Left = 0
    +              Height = 254
    +              Top = 73
    +              Width = 200
    +              Align = alClient
    +              BevelOuter = bvNone
    +              ClientHeight = 254
    +              ClientWidth = 200
    +              TabOrder = 0
    +              object GroupBoxRight: TGroupBox
    +                Left = 0
    +                Height = 64
    +                Top = 0
    +                Width = 200
    +                Align = alTop
    +                Caption = 'Line limit'
    +                ClientHeight = 45
    +                ClientWidth = 198
    +                TabOrder = 0
    +                object MaskEdit1: TMaskEdit
    +                  Left = 9
    +                  Height = 30
    +                  Top = 0
    +                  Width = 128
    +                  CharCase = ecNormal
    +                  MaxLength = 7
    +                  TabOrder = 0
    +                  EditMask = '#######'
    +                  Text = '5000   '
    +                  SpaceChar = '_'
    +                end
    +              end
    +            end
    +          end
    +        end
    +      end
    +    end
       end
    +  object StatusBar1: TStatusBar
    +    Left = 0
    +    Height = 20
    +    Top = 460
    +    Width = 800
    +    Panels = <    
    +      item
    +        Text = '    dumb'
    +        Width = 160
    +      end    
    +      item
    +        Text = '00 x 00 chars'
    +        Width = 160
    +      end    
    +      item
    +        Text = '000 x 000 pixels'
    +        Width = 160
    +      end    
    +      item
    +        Text = 'Not resized'
    +        Width = 160
    +      end>
    +    SimplePanel = False
    +  end
     end
    Index: debugger/pseudoterminaldlg.pp
    ===================================================================
    --- debugger/pseudoterminaldlg.pp	(revision 58550)
    +++ debugger/pseudoterminaldlg.pp	(working copy)
    @@ -30,13 +30,12 @@
     
     {$mode objfpc}{$H+}
     
    -{$IFDEF linux} {$DEFINE DBG_ENABLE_TERMINAL} {$ENDIF}
    -
     interface
     
     uses
    -  IDEWindowIntf, Classes, Graphics,
    -  Forms, StdCtrls, DebuggerDlg, BaseDebugManager, LazarusIDEStrConsts, LCLType;
    +  IDEWindowIntf, Classes, Graphics, Forms, StdCtrls, DebuggerDlg,
    +  BaseDebugManager, LazarusIDEStrConsts, LCLType, ComCtrls, ExtCtrls, MaskEdit,
    +  PairSplitter;
     
     type
     
    @@ -43,9 +42,25 @@
       { TPseudoConsoleDlg }
     
       TPseudoConsoleDlg = class(TDebuggerDlg)
    +    CheckGroupRight: TCheckGroup;
    +    GroupBoxRight: TGroupBox;
    +    MaskEdit1: TMaskEdit;
         Memo1: TMemo;
    +    PageControl1: TPageControl;
    +    PairSplitterRaw: TPairSplitter;
    +    PairSplitterRawLeft: TPairSplitterSide;
    +    PairSplitterRawRight: TPairSplitterSide;
    +    Panel1: TPanel;
    +    PanelRightBelowRG: TPanel;
    +    PanelRightBelowCG: TPanel;
    +    RadioGroupRight: TRadioGroup;
    +    StatusBar1: TStatusBar;
    +    TabSheet1: TTabSheet;
    +    TabSheetRaw: TTabSheet;
         procedure FormResize(Sender: TObject);
         procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
    +    procedure PairSplitterRawRightResize(Sender: TObject);
    +    procedure RadioGroupRightSelectionChanged(Sender: TObject);
       private
         { private declarations }
         ttyHandle: System.THandle;         (* Used only by unix for console size tracking  *)
    @@ -53,6 +68,7 @@
         fCharWidth: word;
         fRowsPerScreen: integer;
         fColsPerRow: integer;
    +    fFirstLine: integer;
         procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
         procedure consoleSizeChanged;
       protected
    @@ -75,10 +91,10 @@
     implementation
     
     uses
    -  SysUtils, LazLoggerBase
    -{$IFDEF DBG_ENABLE_TERMINAL}
    +  SysUtils, StrUtils, LazLoggerBase
    +{$IFDEF UNIX}
       , Unix, BaseUnix, termio
    -{$ENDIF DBG_ENABLE_TERMINAL}
    +{$ENDIF UNIX}
       ;
     
     const
    @@ -98,6 +114,50 @@
     end;
     
     
    +procedure TPseudoConsoleDlg.PairSplitterRawRightResize(Sender: TObject);
    +
    +var
    +  ttyNotYetInitialised: boolean;
    +
    +begin
    +
    +(* These are not errors so much as conditions we will see while the IDE is      *)
    +(* starting up.                                                                 *)
    +
    +  if DebugBoss = nil then
    +    exit;
    +  if DebugBoss.PseudoTerminal = nil then
    +    exit;
    +
    +(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
    +(* so while we prefer success we also consider that failure /is/ an acceptable  *)
    +(* option in this case.                                                         *)
    +
    +  ttyNotYetInitialised := ttyHandle = handleUnopened;
    +  //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.SplitterRawRightResize Calling consoleSizeChanged']);
    +  consoleSizeChanged;
    +  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
    +    DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.SplitterRawRightResize Bad PseudoTerminal -> unopened']);
    +    ttyHandle := handleUnopened
    +  end;
    +  StatusBar1.Panels[3].Text := 'Splitter resized'
    +end { TPseudoConsoleDlg.PairSplitterRawRightResize } ;
    +
    +
    +(* The C1 underbar decoration is only relevant when C0 is being displayed as
    +  control pictures or ISO 2047 glyphs.
    +*)
    +procedure TPseudoConsoleDlg.RadioGroupRightSelectionChanged(Sender: TObject);
    +
    +begin
    +  case RadioGroupRight.ItemIndex of
    +    1, 2: CheckGroupRight.CheckEnabled[1] := true
    +  otherwise
    +    CheckGroupRight.CheckEnabled[1] := false
    +  end
    +end { TPseudoConsoleDlg.RadioGroupRightSelectionChanged } ;
    +
    +
     (* The form size has changed. Call a procedure to pass this to the kernel etc.,
       assuming that this works out the best control to track.
     *)
    @@ -126,23 +186,27 @@
       if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
         DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
         ttyHandle := handleUnopened
    -  end
    -end;
    +  end;
    +  StatusBar1.Panels[3].Text := 'Window resized'
    +end { TPseudoConsoleDlg.FormResize } ;
     
     
     procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
    +
     begin
    -{$IFDEF DBG_ENABLE_TERMINAL}
    +{$IFDEF UNIX}
       if integer(ttyHandle) >= 0 then begin
         FileClose(ttyHandle);
         ttyHandle := handleUnopened
       end;
    -{$ENDIF DBG_ENABLE_TERMINAL}
    +{$ENDIF UNIX}
       inherited DoClose(CloseAction);
       CloseAction := caHide;
    -end;
    +end { TPseudoConsoleDlg.DoClose } ;
     
    +
     constructor TPseudoConsoleDlg.Create(TheOwner: TComponent);
    +
     begin
       inherited Create(TheOwner);
       font.Name := 'monospace';
    @@ -149,8 +213,9 @@
       Caption:= lisDbgTerminal;
       ttyHandle := handleUnopened;
       fRowsPerScreen := -1;
    -  fColsPerRow := -1
    -end;
    +  fColsPerRow := -1;
    +  fFirstLine := 1
    +end { TPseudoConsoleDlg.Create } ;
     
     
     (* Get the height and width for characters described by the fount specified by
    @@ -173,7 +238,7 @@
       finally
         bm.Free
       end
    -end;
    +end { TPseudoConsoleDlg.getCharHeightAndWidth } ;
     
     
     (* Assume that the console size has changed, either because it's just starting
    @@ -184,7 +249,7 @@
     *)
     procedure TPseudoConsoleDlg.consoleSizeChanged;
     
    -{$IFDEF DBG_ENABLE_TERMINAL }
    +{$IFDEF UNIX }
     { DEFINE USE_SLAVE_HANDLE }
     { DEFINE SEND_EXPLICIT_SIGNAL }
     
    @@ -274,35 +339,421 @@
     {$ELSE       }
     begin
       ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
    -{$ENDIF DBG_ENABLE_TERMINAL }
    -  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
    -end;
    +{$ENDIF UNIX }
    +  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit');
    +  RadioGroupRightSelectionChanged(nil); (* Sort out initial state               *)
    +  StatusBar1.Panels[0].Width := Width div 4;
    +  StatusBar1.Panels[0].Text := '    ' ; // + DebugBoss.Debugger.Environment.Values['TERM'];
    +  StatusBar1.Panels[1].Width := Width div 4;
    +  StatusBar1.Panels[1].Text := Format('%d cols x %d rows', [winsize.ws_col, winsize.ws_row]);
    +  StatusBar1.Panels[2].Width := Width div 4;
    +  StatusBar1.Panels[2].Text := Format('%d x %d pixels', [winsize.ws_xpixel, winsize.ws_ypixel])
    +end { TPseudoConsoleDlg.consoleSizeChanged } ;
     
     
     procedure TPseudoConsoleDlg.AddOutput(const AText: String);
     
    +var
    +  lineLimit, numLength, i: integer;
    +  buffer: TStringList;
    +
    +
    +  (* Translate C0 control codes to "control pictures", and optionally C1 codes
    +    to the same glyph but with an underbar.
    +  *)
    +  function withControlPictures(const str: widestring; c1Underbar: boolean): widestring;
    +
    +  const
    +    nul= #$2400;                        // ␀
    +    soh= #$2401;                        // ␁
    +    stx= #$2402;                        // ␂
    +    etx= #$2403;                        // ␃
    +    eot= #$2404;                        // ␄
    +    enq= #$2405;                        // ␅
    +    ack= #$2406;                        // ␆
    +    bel= #$2407;                        // ␇
    +    bs=  #$2408;                        // ␈
    +    ht=  #$2409;                        // ␉
    +    lf=  #$240a;                        // ␊
    +    vt=  #$240b;                        // ␋
    +    ff=  #$240c;                        // ␌
    +    cr=  #$240d;                        // ␍
    +    so=  #$240e;                        // ␎
    +    si=  #$240f;                        // ␏
    +    dle= #$2410;                        // ␐
    +    dc1= #$2411;                        // ␑
    +    dc2= #$2412;                        // ␒
    +    dc3= #$2413;                        // ␓
    +    dc4= #$2414;                        // ␔
    +    nak= #$2415;                        // ␕
    +    syn= #$2416;                        // ␖
    +    etb= #$2417;                        // ␗
    +    can= #$2418;                        // ␘
    +    em=  #$2419;                        // ␙
    +    sub= #$241a;                        // ␚
    +    esc= #$241b;                        // ␛
    +    fs=  #$241c;                        // ␜
    +    gs=  #$241d;                        // ␝
    +    rs=  #$241e;                        // ␞
    +    us=  #$241f;                        // ␟
    +    del= #$2420;                        // ␡
    +    bar= #$033c;                        // ̼'
    +
    +  var
    +    i, test, masked: integer;
    +
    +  begin
    +    result := str;
    +
    +  (* This should probably be recoded to use a persistent table, but doing it    *)
    +  (* this way results in no lookup for plain text which is likely to be the     *)
    +  (* bulk of the output. I'm not making any assumptions about the Unicode       *)
    +  (* characters being sequential so that this code can be used both for control *)
    +  (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
    +  (* want to adjust them he can do so.                                          *)
    +
    +    for i := Length(result) downto 1 do begin
    +      test := Ord(result[i]);
    +      if c1Underbar then
    +        masked := test and $7f          (* Handle both C0 and C1 in one operation *)
    +      else
    +        masked := test;
    +      case masked of
    +        $00: result[i] := nul;
    +        $01: result[i] := soh;
    +        $02: result[i] := stx;
    +        $03: result[i] := etx;
    +        $04: result[i] := eot;
    +        $05: result[i] := enq;
    +        $06: result[i] := ack;
    +        $07: result[i] := bel;
    +        $08: result[i] := bs;
    +        $09: result[i] := ht;
    +        $0a: result[i] := lf;
    +        $0b: result[i] := vt;
    +        $0c: result[i] := ff;
    +        $0d: result[i] := cr;
    +        $0e: result[i] := so;
    +        $0f: result[i] := si;
    +        $10: result[i] := dle;
    +        $11: result[i] := dc1;
    +        $12: result[i] := dc2;
    +        $13: result[i] := dc3;
    +        $14: result[i] := dc4;
    +        $15: result[i] := nak;
    +        $16: result[i] := syn;
    +        $17: result[i] := etb;
    +        $18: result[i] := can;
    +        $19: result[i] := em;
    +        $1a: result[i] := sub;
    +        $1b: result[i] := esc;
    +        $1c: result[i] := fs;
    +        $1d: result[i] := gs;
    +        $1e: result[i] := rs;
    +        $1f: result[i] := us;
    +        $7f: result[i] := del
    +      otherwise
    +      end;
    +      if c1Underbar and                 (* Now fix changed C1 characters        *)
    +                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
    +                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
    +        Insert(bar, result, i + 1)
    +    end
    +  end { withControlPictures } ;
    +
    +
    +  (* Translate C0 control codes to "pretty pictures", and optionally C1 codes
    +    to the same glyph but with an underbar.
    +  *)
    +  function withIso2047(const str: widestring; c1Underbar: boolean): widestring;
    +
    +  (* I've not got access to a pukka copy of ISO-2047, so like (it appears)      *)
    +  (* almost everybody else I'm assuming that the Wikipedia page is correct.     *)
    +  (* this differs from the ECMA standard (only) in the backspace glyph, some    *)
    +  (* terminals in particular the Burroughs TD730/830 range manufactured in the  *)
    +  (* 1970s and 1980s depart slightly more. I've found limited open source       *)
    +  (* projects that refer to this encoding, and those I've found have attempted  *)
    +  (* to "correct" details like the "direction of rotation" of the glyphs for    *)
    +  (* the DC1 through DC4 codes.                                                 *)
    +  (*                                                                            *)
    +  (* Suffixes W, E and B below refer to the variants found in the Wikipedia     *)
    +  (* article, the ECMA standard and the Burroughs terminal documentation.       *)
    +
    +  const
    +    nul=  #$2395;                       // ⎕
    +    soh=  #$2308;                       // ⌈
    +    stx=  #$22A5;                       // ⊥
    +    etx=  #$230B;                       // ⌋
    +    eot=  #$2301;                       // ⌁
    +    enq=  #$22A0;                       // ⊠
    +    ack=  #$2713;                       // ✓
    +    bel=  #$237E;                       // ⍾
    +    bsW=  #$232B;                       // ⌫
    +    bsB=  #$2196;                       // ↖ The ECMA glyph is slightly curved
    +    bs=   bsB;                          //   and has no Unicode representation.
    +    ht=   #$2AAB;                       // ⪫
    +    lf=   #$2261;                       // ≡
    +    vt=   #$2A5B;                       // ⩛
    +    ff=   #$21A1;                       // ↡
    +    crW=  #$2aaa;                       // ⪪ ECMA the same
    +    crB=  #$25bf;                       // ▿
    +    cr=   crW;
    +    so=   #$2297;                       // ⊗
    +    si=   #$2299;                       // ⊙
    +    dle=  #$229F;                       // ⊟
    +    dc1=  #$25F7;                       // ◷ Nota bene: these rotate deosil
    +    dc2=  #$25F6;                       // ◶
    +    dc3=  #$25F5;                       // ◵
    +    dc4=  #$25F4;                       // ◴
    +    nak=  #$237B;                       // ⍻
    +    syn=  #$238D;                       // ⎍
    +    etb=  #$22A3;                       // ⊣
    +    can=  #$29D6;                       // ⧖
    +    em=   #$237F;                       // ⍿
    +    sub=  #$2426;                       // ␦
    +    esc=  #$2296;                       // ⊖
    +    fs=   #$25F0;                       // ◰ Nota bene: these rotate widdershins
    +    gsW=  #$25F1;                       // ◱ ECMA the same
    +    gsB=  #$25b5;                       // ▵
    +    gs=   gsW;
    +    rsW=  #$25F2;                       // ◲ ECMA the same
    +    rsB=  #$25c3;                       // ◃
    +    rs=   rsW;
    +    usW=  #$25F3;                       // ◳ ECMA the same
    +    usB=  #$25b9;                       // ▹
    +    us=   usW;
    +    del=  #$2425;                       // ␥
    +    bar=  #$033c;                       // ̼'
    +
    +(* Not represented above is a Burroughs glyph for ETX, which in the material    *)
    +(* available to me appears indistinguisable from CAN. If anybody has variant    *)
    +(* glyphs from other manufacturers please contribute.                           *)
    +
    +  var
    +    i, test, masked: integer;
    +
    +  begin
    +    result := str;
    +
    +  (* This should probably be recoded to use a persistent table, but doing it    *)
    +  (* this way results in no lookup for plain text which is likely to be the     *)
    +  (* bulk of the output. I'm not making any assumptions about the Unicode       *)
    +  (* characters being sequential so that this code can be used both for control *)
    +  (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
    +  (* want to adjust them she can do so.                                         *)
    +
    +    for i := Length(result) downto 1 do begin
    +      test := Ord(result[i]);
    +      if c1Underbar then
    +        masked := test and $7f          (* Handle both C0 and C1 in one operation *)
    +      else
    +        masked := test;
    +      case masked of
    +        $00: result[i] := nul;
    +        $01: result[i] := soh;
    +        $02: result[i] := stx;
    +        $03: result[i] := etx;
    +        $04: result[i] := eot;
    +        $05: result[i] := enq;
    +        $06: result[i] := ack;
    +        $07: result[i] := bel;
    +        $08: result[i] := bs;
    +        $09: result[i] := ht;
    +        $0a: result[i] := lf;
    +        $0b: result[i] := vt;
    +        $0c: result[i] := ff;
    +        $0d: result[i] := cr;
    +        $0e: result[i] := so;
    +        $0f: result[i] := si;
    +        $10: result[i] := dle;
    +        $11: result[i] := dc1;
    +        $12: result[i] := dc2;
    +        $13: result[i] := dc3;
    +        $14: result[i] := dc4;
    +        $15: result[i] := nak;
    +        $16: result[i] := syn;
    +        $17: result[i] := etb;
    +        $18: result[i] := can;
    +        $19: result[i] := em;
    +        $1a: result[i] := sub;
    +        $1b: result[i] := esc;
    +        $1c: result[i] := fs;
    +        $1d: result[i] := gs;
    +        $1e: result[i] := rs;
    +        $1f: result[i] := us;
    +        $7f: result[i] := del
    +      otherwise
    +      end;
    +      if c1Underbar and                 (* Now fix changed C1 characters        *)
    +                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
    +                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
    +        Insert(bar, result, i + 1)
    +    end
    +  end { withIso2047 } ;
    +
    +
    +  (* Look at the line index cl in a TStringList. Assume that at the start there
    +    will be a line number and padding occupying nl characters, after that will
    +    be text. Convert the text to hex possibly inserting extra lines after the
    +    one being processed, only the first (i.e. original) line has a line number.
    +  *)
    +  procedure expandAsHex(var stringList: TStringList; currentLine, lineNumberLength: integer);
    +
    +  var
    +    lineNumberAsText,     scratch     : string;
    +    dataAsByteArray: TBytes;
    +    lengthLastBlock, startLastBlock: integer;
    +
    +
    +    (* Recursively process the byte array from the end to the beginning. All
    +      lines are inserted immediately after the original current line, except for
    +      the final line processed which overwrites the original.
    +    *)
    +    procedure hexLines(start, bytes: integer);
    +
    +
    +      (* The parameter is a line number as text or an equivalent run of spaces.
    +        The result is a line of hex + ASCII data.
    +      *)
    +      function oneHexLine(const lineNum: string): widestring;
    +
    +      var
    +        i: integer;
    +
    +      begin
    +        result := lineNum;
    +        for i := 0 to 15 do
    +          if i < bytes then
    +            result += LowerCase(HexStr(dataAsByteArray[start + i], 2)) + ' '
    +          else
    +            result += '   ';
    +        result += ' ';                  (* Between hex and ASCII                *)
    +        for i := 0 to 15 do
    +          if i < bytes then
    +            case dataAsByteArray[start + i] of
    +              $20..$7e: result += Chr(dataAsByteArray[start + i])
    +            otherwise
    +              result += #$00B7          // ·
    +            end
    +      end { oneHexLine } ;
    +
    +
    +    begin
    +      if start = 0 then
    +        stringList[currentLine] := oneHexLine(lineNumberAsText)
    +      else begin
    +        stringList.insert(currentLine + 1, oneHexLine(PadLeft('', Length(lineNumberAsText))));
    +        hexLines(start - 16, 16)
    +      end
    +    end { hexLines } ;
    +
    +
    +  begin
    +    if lineNumberLength = 0 then begin
    +      lineNumberAsText := '';
    +      dataAsByteArray := BytesOf(Copy(stringList[currentLine], 1,
    +                                Length(stringList[currentLine])))
    +    end else begin                      (* Remember one extra space after number *)
    +      lineNumberAsText := Copy(stringList[currentLine], 1, lineNumberLength + 1);
    +      dataAsByteArray := BytesOf(Copy(stringList[currentLine], lineNumberLength + 2,
    +                                Length(stringList[currentLine]) - (lineNumberLength + 1)))
    +    end;
    +    lengthLastBlock := Length(dataAsByteArray) mod 16;
    +    startLastBlock := Length(dataAsByteArray) - lengthLastBlock;
    +    hexLines(startLastBlock, lengthLastBlock)
    +  end { expandAsHex } ;
    +
    +
     begin
       if ttyHandle = handleUnopened then begin (* Do this at first output only      *)
         //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.AddOutput Calling consoleSizeChanged']);
         consoleSizeChanged
       end;
    -  while Memo1.Lines.Count > 5000 do
    +
    +(* Get the maximum number of lines to be displayed from the user interface,     *)
    +(* work out how much space is needed to display a line number, and if necessary *)
    +(* trim the amount of currently-stored text.                                    *)
    +
    +  try
    +    lineLimit := StrToInt(Trim(MaskEdit1.Text))
    +  except
    +    MaskEdit1.Text := '5000';
    +    lineLimit := 5000
    +  end;
    +  if CheckGroupRight.Checked[0] then    (* Line numbers?                        *)
    +    case lineLimit + fFirstLine - 1 of
    +      0..999:          numLength := 3;
    +      1000..99999:     numLength := 5;
    +      100000..9999999: numLength := 7
    +    otherwise
    +      numLength := 9
    +    end
    +  else
    +    numLength := 0;
    +  Memo1.Lines.BeginUpdate;
    +  while Memo1.Lines.Count > lineLimit do
         Memo1.Lines.Delete(0);
     
    -// Working note: make any adjustment to the number of lines etc. before we
    -// start to add text which might include escape handling.
    +(* Use an intermediate buffer to process the line or potentially lines of text  *)
    +(* passed as the parameter; where formatting as hex breaks it up into multiple  *)
    +(* lines, the line number is blanked on the synthetic ones. When lines or lists *)
    +(* of lines are processed in reverse it is because an indeterminate number of   *)
    +(* insertions (e.g. Unicode combining diacritics or extended hex output) may be *)
    +(* inserted after the current index.                                            *)
    +(*                                                                              *)
    +(* This might look like a bit of a palaver, but a standard memo might exhibit   *)
    +(* "interesting" behavior once the amount of text causes it to start scrolling  *)
    +(* so having an intermediate that can be inspected might be useful.             *)
     
    -  Memo1.Text:=Memo1.Text+AText;
    -  Memo1.SelStart := length(Memo1.Text);
    -end;
    +  buffer := TStringList.Create;
    +  try
    +    buffer.Text := AText;     (* Decides what line breaks it wants to swallow   *)
    +    if buffer.Count = 1 then
    +      i := 12345              (* Good place for a breakpoint                    *)
    +    else
    +      i := 67890;             (* Another good place for a breakpoint            *)
    +    case RadioGroupRight.ItemIndex of
    +      1: for i := 0 to buffer.Count - 1 do
    +           buffer[i] := withControlPictures(buffer[i], CheckGroupRight.Checked[1]);
    +      2: for i := 0 to buffer.Count - 1 do
    +           buffer[i] := withIso2047(buffer[i], CheckGroupRight.Checked[1])
    +    otherwise
    +    end;
    +    for i := 0 to buffer.Count - 1 do begin             (* Line numbers         *)
    +      if numLength > 0 then
    +        buffer[i] := PadLeft(IntToStr(fFirstLine), numLength) + ' ' + buffer[i];
    +      fFirstLine += 1
    +    end;
    +    if RadioGroupRight.ItemIndex = 3 then (* Expand hex line-by-line in reverse *)
    +      for i := buffer.Count - 1 downto 0 do
    +        expandAsHex(buffer, i, numLength);
     
    +(* Add the buffered text to the visible control(s), and clean up.               *)
    +
    +    Memo1.Lines.AddStrings(buffer)
    +  finally
    +    buffer.Free;
    +    Memo1.Lines.EndUpdate
    +  end;
    +  Memo1.SelStart := length(Memo1.Text)
    +end { TPseudoConsoleDlg.AddOutput } ;
    +
    +
     procedure TPseudoConsoleDlg.Clear;
    +
     begin
       //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.Clear Calling FormResize']);
    -  FormResize(nil);                      (* Safe during IDE initialisation       *)
    -  Memo1.Text := '';
    -end;
    +  Memo1.Lines.BeginUpdate;
    +  try
    +    FormResize(nil);                    (* Safe during IDE initialisation       *)
    +    Memo1.Text := ''
    +  finally
    +    Memo1.Lines.EndUpdate;
    +  end;
    +  fFirstLine := 1
    +end { TPseudoConsoleDlg.Clear } ;
     
    +
     {$R *.lfm}
     
     initialization
    Index: debugger/test/watchconsolesize.pas
    ===================================================================
    --- debugger/test/watchconsolesize.pas	(revision 58550)
    +++ debugger/test/watchconsolesize.pas	(working copy)
    @@ -53,6 +53,8 @@
     
     
     begin
    +  WriteLn('This header line comprises 50 characters plus EOL.');
    +  WriteLn;
       WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
       reportSize;
       if not hookWinch() then
    Index: ide/lazarus.lpi
    ===================================================================
    --- ide/lazarus.lpi	(revision 58550)
    +++ ide/lazarus.lpi	(working copy)
    @@ -1429,10 +1429,10 @@
           <OtherUnitFiles Value="frames;../converter;../debugger;../debugger/frames;../packager;../designer;../packager/frames;../ide"/>
           <UnitOutputDirectory Value="$(LazarusDir)/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
         </SearchPaths>
    -    <CompileReasons Compile="False" Build="False" Run="False"/>
    +    <CompileReasons Run="False"/>
       </CompilerOptions>
       <Debugging>
    -    <Exceptions Count="2">
    +    <Exceptions Count="3">
           <Item1>
             <Name Value="EAbort"/>
           </Item1>
    @@ -1439,6 +1439,9 @@
           <Item2>
             <Name Value="ECodetoolError"/>
           </Item2>
    +      <Item3>
    +        <Name Value="EReadError"/>
    +      </Item3>
         </Exceptions>
       </Debugging>
     </CONFIG>
    
  • debug-console-fixes.diff (6,618 bytes)
    Index: debugger/pseudoterminaldlg.pp
    ===================================================================
    --- debugger/pseudoterminaldlg.pp	(revision 58584)
    +++ debugger/pseudoterminaldlg.pp	(working copy)
    @@ -367,7 +367,7 @@
       (* Translate C0 control codes to "control pictures", and optionally C1 codes
         to the same glyph but with an underbar.
       *)
    -  function withControlPictures(const str: widestring; c1Underbar: boolean): widestring;
    +  function withControlPictures(const str: string; c1Underbar: boolean): widestring;
     
       const
         nul= #$2400;                        // ␀
    @@ -407,9 +407,10 @@
     
       var
         i, test, masked: integer;
    +    changed: boolean;
     
       begin
    -    result := str;
    +    SetLength(result, Length(str));
     
       (* This should probably be recoded to use a persistent table, but doing it    *)
       (* this way results in no lookup for plain text which is likely to be the     *)
    @@ -418,12 +419,13 @@
       (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
       (* want to adjust them he can do so.                                          *)
     
    -    for i := Length(result) downto 1 do begin
    -      test := Ord(result[i]);
    +    for i := Length(str) downto 1 do begin
    +      test := Ord(str[i]);
           if c1Underbar then
             masked := test and $7f          (* Handle both C0 and C1 in one operation *)
           else
             masked := test;
    +      changed := true;
           case masked of
             $00: result[i] := nul;
             $01: result[i] := soh;
    @@ -459,11 +461,12 @@
             $1f: result[i] := us;
             $7f: result[i] := del
           otherwise
    +        result[i] := Chr(test);
    +        changed := false;
           end;
    -      if c1Underbar and                 (* Now fix changed C1 characters        *)
    -                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
    -                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
    -        Insert(bar, result, i + 1)
    +      if c1Underbar and changed and     (* Now fix changed C1 characters        *)
    +                                (masked <> test) then
    +        Insert(bar, result, i)
         end
       end { withControlPictures } ;
     
    @@ -471,7 +474,7 @@
       (* Translate C0 control codes to "pretty pictures", and optionally C1 codes
         to the same glyph but with an underbar.
       *)
    -  function withIso2047(const str: widestring; c1Underbar: boolean): widestring;
    +  function withIso2047(const str: string; c1Underbar: boolean): widestring;
     
       (* I've not got access to a pukka copy of ISO-2047, so like (it appears)      *)
       (* almost everybody else I'm assuming that the Wikipedia page is correct.     *)
    @@ -537,9 +540,10 @@
     
       var
         i, test, masked: integer;
    +    changed: boolean;
     
       begin
    -    result := str;
    +    SetLength(result, Length(str));
     
       (* This should probably be recoded to use a persistent table, but doing it    *)
       (* this way results in no lookup for plain text which is likely to be the     *)
    @@ -548,12 +552,13 @@
       (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
       (* want to adjust them she can do so.                                         *)
     
    -    for i := Length(result) downto 1 do begin
    -      test := Ord(result[i]);
    +    for i := Length(str) downto 1 do begin
    +      test := Ord(str[i]);
           if c1Underbar then
             masked := test and $7f          (* Handle both C0 and C1 in one operation *)
           else
             masked := test;
    +      changed := true;
           case masked of
             $00: result[i] := nul;
             $01: result[i] := soh;
    @@ -589,15 +594,44 @@
             $1f: result[i] := us;
             $7f: result[i] := del
           otherwise
    +        result[i] := Chr(test);
    +        changed := false;
           end;
    -      if c1Underbar and                 (* Now fix changed C1 characters        *)
    -                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
    -                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
    -        Insert(bar, result, i + 1)
    +      if c1Underbar and changed and     (* Now fix changed C1 characters        *)
    +                                (masked <> test) then
    +        Insert(bar, result, i)
         end
       end { withIso2047 } ;
     
     
    +  (* Convert the string that's arrived from GDB etc. into UTF-8. In this case
    +    it's mostly a dummy operation, except that there might be widget-set-specific
    +    hacks.
    +  *)
    +  function widen(const str: string): widestring;
    +
    +  const
    +    dot= #$00B7;                        // ·
    +
    +  var
    +    i: integer;
    +
    +  begin
    +    SetLength(result, Length(str));
    +    for i := Length(str) downto 1 do
    +      case str[i] of
    +        ' ': result[i] := ' ';          (* Satisfy syntax requirement           *)
    +        #$00: result[i] := dot;         (* GTK2 really doesn't like seeing this *)
    +//        #$01..#$0f:   result[i] := dot;
    +//        #$10..#$1f: result[i] := dot;
    +//        #$7f:       result[i] := dot;
    +//        #$80..#$ff: result[i] := dot
    +      otherwise
    +        result[i] := str[i]
    +      end
    +  end { widen } ;
    +
    +
       (* Look at the line index cl in a TStringList. Assume that at the start there
         will be a line number and padding occupying nl characters, after that will
         be text. Convert the text to hex possibly inserting extra lines after the
    @@ -606,7 +640,7 @@
       procedure expandAsHex(var stringList: TStringList; currentLine, lineNumberLength: integer);
     
       var
    -    lineNumberAsText,     scratch     : string;
    +    lineNumberAsText: string;
         dataAsByteArray: TBytes;
         lengthLastBlock, startLastBlock: integer;
     
    @@ -664,7 +698,10 @@
           dataAsByteArray := BytesOf(Copy(stringList[currentLine], lineNumberLength + 2,
                                     Length(stringList[currentLine]) - (lineNumberLength + 1)))
         end;
    -    lengthLastBlock := Length(dataAsByteArray) mod 16;
    +    if (Length(dataAsByteArray) > 0) and ((Length(dataAsByteArray) mod 16) = 0) then
    +      lengthLastBlock := 16
    +    else
    +      lengthLastBlock := Length(dataAsByteArray) mod 16;
         startLastBlock := Length(dataAsByteArray) - lengthLastBlock;
         hexLines(startLastBlock, lengthLastBlock)
       end { expandAsHex } ;
    @@ -719,6 +756,8 @@
         else
           i := 67890;             (* Another good place for a breakpoint            *)
         case RadioGroupRight.ItemIndex of
    +      0: for i := 0 to buffer.Count - 1 do
    +           buffer[i] := widen(buffer[i]);
           1: for i := 0 to buffer.Count - 1 do
                buffer[i] := withControlPictures(buffer[i], CheckGroupRight.Checked[1]);
           2: for i := 0 to buffer.Count - 1 do
    
    debug-console-fixes.diff (6,618 bytes)
  • debug-console-fixes2.diff (3,696 bytes)
    Index: debugger/pseudoterminaldlg.pp
    ===================================================================
    --- debugger/pseudoterminaldlg.pp	(revision 58593)
    +++ debugger/pseudoterminaldlg.pp	(working copy)
    @@ -95,7 +95,7 @@
     uses
       SysUtils, StrUtils, LazLoggerBase
     {$IFDEF DBG_ENABLE_TERMINAL}
    -  , Unix, BaseUnix, termio
    +  , Unix, BaseUnix, termio, LCLPlatformDef, InterfaceBase
     {$ENDIF DBG_ENABLE_TERMINAL}
       ;
     
    @@ -604,9 +604,9 @@
       end { withIso2047 } ;
     
     
    -  (* Convert the string that's arrived from GDB etc. into UTF-8. In this case
    -    it's mostly a dummy operation, except that there might be widget-set-specific
    -    hacks.
    +  (* Convert the string with unknown encoding that's arrived from GDB etc. into
    +    UTF-8. In this case it's mostly a dummy operation, except that there might
    +    be widget-set-specific hacks.
       *)
       function widen(const str: string): widestring;
     
    @@ -618,17 +618,30 @@
     
       begin
         SetLength(result, Length(str));
    -    for i := Length(str) downto 1 do
    -      case str[i] of
    -        ' ': result[i] := ' ';          (* Satisfy syntax requirement           *)
    -        #$00: result[i] := dot;         (* GTK2 really doesn't like seeing this *)
    -//        #$01..#$0f:   result[i] := dot;
    -//        #$10..#$1f: result[i] := dot;
    -//        #$7f:       result[i] := dot;
    -//        #$80..#$ff: result[i] := dot
    -      otherwise
    -        result[i] := str[i]
    -      end
    +    case GetDefaultLCLWidgetType() of
    +      lpGtk2:   for i := Length(str) downto 1 do
    +                  case str[i] of
    +                    #$00: result[i] := dot (* GTK2 really doesn't like seeing this *)
    +                  otherwise
    +                    result[i] := str[i]
    +                  end
    +    otherwise
    +
    +(* I've left this doing it "the long way" to make it easy to rough out a filter *)
    +(* for a hitherto-unhandled widget set.                                         *)
    +
    +      for i := Length(str) downto 1 do
    +        case str[i] of
    +          ' ': result[i] := ' ';          (* Satisfy syntax requirement           *)
    +//          #$00:       result[i] := dot;
    +//          #$01..#$0f: result[i] := dot;
    +//          #$10..#$1f: result[i] := dot;
    +//          #$7f:       result[i] := dot;
    +//          #$80..#$ff: result[i] := dot
    +        otherwise
    +          result[i] := str[i]
    +        end
    +    end
       end { widen } ;
     
     
    Index: debugger/test/testconsolescroll.pas
    ===================================================================
    --- debugger/test/testconsolescroll.pas	(revision 58593)
    +++ debugger/test/testconsolescroll.pas	(working copy)
    @@ -1,9 +1,10 @@
     program TestConsoleScroll;
     
     (* This console-mode program for Linux or other unix implementations outputs	*)
    -(* 100 numbered lines, followed by all 256 8-bit characters as a block. The	*)
    -(* lines should be presented without intervening blanks, the character block	*)
    -(* should make sense provided that a formatted console style is selected.	*)
    +(* 100 numbered lines, followed by all 256 8-bit characters as a block plus a   *)
    +(* couple of explicit currency symbols. The lines should be presented without   *)
    +(* intervening blanks, the character block should make sense provided that a    *)
    +(* formatted console style is selected.	                                        *)
     (*										*)
     (* It DOES NOT attempt any formatted output using escape sequences etc. MarkMLl	*)
     
    @@ -18,10 +19,13 @@
         WriteLn(i);
       WriteLn;
       for i := 0 to 15 do begin
    -    for j := 1 to 15 do
    +    for j := 0 to 15 do
           Write(Chr(16 * i + j));
         WriteLn
       end;
    -  WriteLn 
    +  WriteLn;
    +  WriteLn('UK currency symbol: £');
    +  WriteLn('EU currency symbol: €');
    +  WriteLn
     end.
       
    

Relationships

related to 0033652 closedMartin Friebe change "Terminal Output" font to monospace 
related to 0035071 closedMartin Friebe Console/Terminal crashes an app if closed before the app itself is closed. 

Activities

Martin Friebe

2018-07-01 19:10

manager   ~0109163

Last edited: 2018-07-01 19:12

View 2 revisions

"Debug Output" is for debugging the debugger only. In a way a left over from the old days. Nowadays better feedback can be provided with --debug-log, but there was no reason to remove the window. Maybe it should be moved to View > "Ide Internals".

"console" was recently changed to monospace. A patch for a configurable font is always welcome.

The console window is currently a raw stream of the programs output. It has no terminal emulation or similar.
Terminal implementation would be welcome, and the window should then provide 2 tabs:
- raw output (optional: show special chars)
- terminal output (which can have options to send signals)

The IDE's console window is not used on windows. Windows provides a console win, even under the debugger.

Mark Morgan Lloyd

2018-07-01 21:57

reporter   ~0109168

Last edited: 2018-07-02 11:37

View 2 revisions

Thanks for that. I /thought/ I'd seen something about the font but couldn't find it: I was obviously searching on the wrong term.

The console window doesn't need any terminal emulation (at least for what I'm suggesting), only to have some awareness of a nominal size and to raise the signal on a change.

If somebody were to look at this, would it be best to retain the existing memo as a convenient text-based control or to start afresh with a custom control? I'd have thought that a memo would have been adequate for basic screen/line clearing commands etc., and that things like text/background colour were overkill.

Martin Friebe

2018-07-02 12:55

manager   ~0109184

It will be ok to add partial solutions. So the type of ctrl may not yet matter.

For signals a checkbox can be added to the form, allowing to enable/disable them.

I suggest to have 2 tabs on the form. One with the current memo (raw output), which can (if wanted) be changed to display special chars. And the other with whatever control is suitable, this can be a memo, and later change.
Only the 2nd tab would clear the screen, the first would keep the data visible.

Mark Morgan Lloyd

2018-07-02 13:30

reporter   ~0109188

OK, but basically where does one find things? It looks as though at present the memo is sitting in a special dialogue rather than on a standard form... if you could rough out an ordinary form with a memo on it so that those of us who know terminals but are a bit shaky on the IDE innards had something to chew on it would make life far easier.

The way I see it at present the form/control would need to export a TERM shell variable for use by the child process (probably "ansi" or "ansi-mono"), for unix systems it would need access to the tty handle (so it could tell it what size to assume) and PID (so it could signal that with a warning the size had changed). The rest is fairly straightforward, i.e. monitoring the incoming stream for escape sequences, and translating function key events into escape sequences rather than single characters.

I notice that "Tito's Terminal" is based on Synedit.

Martin Friebe

2018-07-02 18:17

manager   ~0109193

Last edited: 2018-07-02 18:22

View 2 revisions

lazarus\debugger\pseudoterminaldlg.pp
Its all in there.

The debugger creates a virtual pty (search for procedure InitConsole; in components\lazdebuggergdbmi\gdbmidebugger.pp )

You may need the pid from the debugger, or extend the debugger to send signals.

Note that not all debuggers have a pid (or it may not be valid). Remotedebuggers have (if at all) the pid on the remote system.

So best would be to look at DebugBoss.DoSendConsoleInput
and implement DebugBoss.DoSendSignal

----------------
About environment.

This is set in "Run Parameters".
It be best to set them there (a shortcut like for display id could be added).
The settings could be replicated to the console window, but should always be kept accessible through "run param".
ide/runparamsopts.pas

Mark Morgan Lloyd

2018-07-03 16:40

reporter   ~0109207

I'd somehow managed to miss the .frm earlier, so was only seeing half the picture.

I'll try to fit in some time looking at this, but will probably need to consult on details.

The terminal type will need thought, since getting what the child process is told is available out of step with what the IDE can offer will be a problem.

Mark Morgan Lloyd

2018-07-04 11:52

reporter   ~0109214

OK. So I'm opening a local handle for the tty in PseudoTerminalDlg so that I can tell it the control size. How should I get at DeviceName, which contains the name of the slave side of the pty?

Martin Friebe

2018-07-04 12:40

manager   ~0109216

Last edited: 2018-07-04 12:40

View 2 revisions

Would it help if there was (on the TDebuggerIntf / base class) a public read-only property
PseudoTerminal: TPseudoTerminal;
?

Thus you could access all the data of the pty from there.

You would have to check for none nil. Not all debuggers create a pseudo terminal.

===
A better idea might be to put an abstraction layer around it. So that some properties could be used in other cases.
Such as the stdout goes to a file, or /dev/null, or real terminal (not owned by the IDE). Then the name of that would also be available.

But that can be done later. The property can be marked as experimental, and later be adapted.

Mark Morgan Lloyd

2018-07-04 13:34

reporter   ~0109218

I think it would be highly desirable to confine me to pseudoterminaldlg. I'm entirely happy with things being marked as "experimental (implementer doesn't know what he's doing)" or whatever :-)

As I see it, the three things I need to be able to handle window resizes and possibly some level of cursor control etc. are

(a) A (name so that I can open a) handle for the slave side of the pty hence tell it what window size to assume (all bets are off if TIOCSWINSZ turns out to need root or elevated capabilities).

(b) A PID for the process being debugged (not for the debugger, since gdb will break on a sigwinch) so I can signal it.

(c) The TERM shell/environment variable so that the pseudoconsole handler can decide whether it's competent to display formatted output (i.e. enable a second tab only if the terminal type is ansi or whatever).

That's the order I'm looking at things in, since I think in general that a (console) program would expect to be able to find out its window size before it would expect to be able to track changes and so on.

Martin Friebe

2018-07-04 17:49

manager  

ttycontrol.patch (4,420 bytes)
Index: components/debuggerintf/dbgintfdebuggerbase.pp
===================================================================
--- components/debuggerintf/dbgintfdebuggerbase.pp	(revision 58438)
+++ components/debuggerintf/dbgintfdebuggerbase.pp	(working copy)
@@ -80,7 +80,8 @@
     dcDisassemble,
     dcStepOverInstr,
     dcStepIntoInstr,
-    dcSendConsoleInput
+    dcSendConsoleInput,
+    dcSendSignal
     );
   TDBGCommands = set of TDBGCommand;
 
@@ -1842,6 +1843,7 @@
     // prevent destruction while nested in any call
     procedure LockRelease; virtual;
     procedure UnlockRelease; virtual;
+    function GetPseudoTerminal: TPseudoTerminal; virtual;
   public
     class function Caption: String; virtual;         // The name of the debugger as shown in the debuggeroptions
     class function ExePaths: String; virtual;        // The default locations of the exe
@@ -1913,6 +1915,7 @@
     property Registers: TRegisterSupplier read FRegisters;                           // list of all registers
     property Signals: TDBGSignals read FSignals;                                 // A list of actions for signals we know
     property ShowConsole: Boolean read FShowConsole write FShowConsole;          // Indicates if the debugger should create a console for the debuggee
+    property PseudoTerminal: TPseudoTerminal read GetPseudoTerminal; experimental 'may be replaced with a more general API';;
     property State: TDBGState read FState;                                       // The current state of the debugger
     property SupportedCommands: TDBGCommands read GetSupportedCommands;          // All available commands of the debugger
     property TargetWidth: Byte read GetTargetWidth;                              // Currently only 32 or 64
@@ -2001,11 +2004,11 @@
              dcSendConsoleInput],
   {dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcStepOverInstr, dcStepIntoInstr,
              dcStepOut, dcRunTo, dcJumpto, dcDetach, dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify,
-             dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput],
+             dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput, dcSendSignal],
   {dsInternalPause} // same as run, so not really used
-            [dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
+            [dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput, dcSendSignal],
   {dsInit } [],
-  {dsRun  } [dcPause, dcStop, dcDetach, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
+  {dsRun  } [dcPause, dcStop, dcDetach, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput, dcSendSignal],
   {dsError} [dcStop],
   {dsDestroying} []
   );
@@ -5857,6 +5860,11 @@
   FCurEnvironment.Assign(FEnvironment);
 end;
 
+function TDebuggerIntf.GetPseudoTerminal: TPseudoTerminal;
+begin
+  Result := nil;
+end;
+
 //function TDebuggerIntf.GetUnitInfoProvider: TDebuggerUnitInfoProvider;
 //begin
 //  Result := FUnitInfoProvider;
Index: components/lazdebuggergdbmi/gdbmidebugger.pp
===================================================================
--- components/lazdebuggergdbmi/gdbmidebugger.pp	(revision 58438)
+++ components/lazdebuggergdbmi/gdbmidebugger.pp	(working copy)
@@ -860,6 +860,7 @@
     {$IFDEF DBG_ENABLE_TERMINAL}
     FPseudoTerminal: TPseudoTerminal;
     procedure ProcessWhileWaitForHandles; override;
+    function GetPseudoTerminal: TPseudoTerminal; override;
     {$ENDIF}
     procedure QueueExecuteLock;
     procedure QueueExecuteUnlock;
@@ -8909,6 +8910,7 @@
       {$IFDEF DBG_ENABLE_TERMINAL}
       dcSendConsoleInput: FPseudoTerminal.Write(String(AParams[0].VAnsiString));
       {$ENDIF}
+      dcSendSignal: ; // kill(FTargetInfo, AParams[1]);
     end;
   finally
     UnlockRelease;
@@ -9005,6 +9007,11 @@
   inherited ProcessWhileWaitForHandles;
   FPseudoTerminal.CheckCanRead;
 end;
+
+function TGDBMIDebugger.GetPseudoTerminal: TPseudoTerminal; override;
+begin
+  Result := FPseudoTerminal;
+end;
 {$ENDIF}
 
 procedure TGDBMIDebugger.QueueExecuteLock;
Index: debugger/pseudoterminaldlg.pp
===================================================================
--- debugger/pseudoterminaldlg.pp	(revision 58438)
+++ debugger/pseudoterminaldlg.pp	(working copy)
@@ -40,6 +40,7 @@
   var UTF8Key: TUTF8Char);
 begin
   DebugBoss.DoSendConsoleInput(Utf8Key);
+  //DebugBoss.Debugger.PseudoTerminal;
   Utf8Key := '';
 end;
 
ttycontrol.patch (4,420 bytes)

Martin Friebe

2018-07-04 18:03

manager   ~0109219

Last edited: 2018-07-04 18:05

View 2 revisions

The attached patch should help with A & B.
Please re-include it in your patch, so I do not need to apply 2 patches later.

A)
It exposes the pseudo terminal: DebugBoss.Debugger.PseudoTerminal;
That should give you access to the name.

You need to do nil checks for everything.
Maybe also check the debuggerstate, and maybe register the dialog to get state updates. (hardcoded, into the list / need to search, somewhere all the watches,stack.... are informed)

B)
Signal should be send by the debugger backend.
I added a command
DebugBoss.Debugger.ReqCmd(dcSendSignal, [4]); // or whatever number the signal has

You need to implement the code in gdbmidebugger (the patch shows where)

You need to test, what happens to the signal, if the target is paused.
If needed, store the request, and act on it later.

C)
I havent looked at this.
The debugger exposes the environment it was given, so for read only
DebugBoss.Debugger.Environment


-------------
dcSendSignal may need to be added in gdbmidebugger, as supported command. (look for the other commands).
Make sure it is not in the inherited remote debuggers

Mark Morgan Lloyd

2018-07-04 20:51

reporter   ~0109221

I think I see what you're doing but when I compile with the patch applied it tells me that

+ function GetPseudoTerminal: TPseudoTerminal; virtual;

dbgintfdebuggerbase.pp(1823,33) Error: Identifier not found "TPseudoTerminal"

If I edit the interface uses to look like this

...
  DbgIntfBaseTypes, DbgIntfMiscClasses, GDBMIDebugger;

I get

dbgintfdebuggerbase.pp(53,41) Fatal: Cannot find GDBMIDebugger used by DbgIntfDebuggerBase. Check if package LazDebuggerGdbmi is in the dependencies of package DebuggerIntf.

at which point I feel I'm getting outside my pay grade :-)

Martin Friebe

2018-07-04 22:59

manager   ~0109224

Actually it is in GDBMIMiscClasses.

But that can not be used either.
Just move that class into a new unit in the package DebuggerIntf (same package as dbgintfdebuggerbase).

Then use that unit in dbgintfdebuggerbase and GDBMIDebugger.

Mark Morgan Lloyd

2018-07-05 11:40

reporter   ~0109228

Last edited: 2018-07-05 11:53

View 2 revisions

I think that IDEMiniLibC might need to be moved from LazDebuggerGdbmi to DebuggerIntf i.e. tracking the definition of TPseudoTerminal. Does that make sense? I'm being cautious here...

If I move the unit between packages, should I move the physical file as well or leave that for you to do?

Martin Friebe

2018-07-05 12:14

manager   ~0109229

Yes it needs to be moved, and yes move the file too.

It makes sense to have it in the DebuggerIntf, so other debuggers can later benefit from it too.

Mark Morgan Lloyd

2018-07-06 00:45

reporter   ~0109231

Last edited: 2018-07-07 11:51

View 3 revisions

I've got the mods in, but had the odd situation that the only way I was able to recompile was using a second checked-out copy of trunk and even then there were some things that didn't click into place until I was self-compiling (e.g. like the extra entry in the command name array).

I've still got a reference to lazconf.inc which has to be fully qualified, there's a path missing somewhere.

Basic operation is OK, I can get a handle for the tty and write a plausible size to it. I don't have any viable way yet of making sure that's getting all the way to the program getting debugged, with luck things will be a bit clearer once I'm able to generate a signal which I think would be a good point to get patches back to you.

[Next morning] It looks as though all I have to do is use the PTY /master/ handle, and that a signal is sent automatically when I tell that handle that the size has changed.

[Much later] This works but is fragile, but I'm fairly confident that the basic concept is OK. I'll be back.

Mark Morgan Lloyd

2018-07-07 16:53

reporter  

debug-console-winch-support.diff (35,839 bytes)
Index: components/debuggerintf/dbgintfdebuggerbase.pp
===================================================================
--- components/debuggerintf/dbgintfdebuggerbase.pp	(revision 58442)
+++ components/debuggerintf/dbgintfdebuggerbase.pp	(working copy)
@@ -50,7 +50,7 @@
   // LazUtils
   LazClasses, LazLoggerBase, LazFileUtils, Maps, LazMethodList,
   // DebuggerIntf
-  DbgIntfBaseTypes, DbgIntfMiscClasses;
+  DbgIntfBaseTypes, DbgIntfMiscClasses, DbgIntfPseudoTerminal;
 
 const
   DebuggerIntfVersion = 0;
@@ -80,7 +80,8 @@
     dcDisassemble,
     dcStepOverInstr,
     dcStepIntoInstr,
-    dcSendConsoleInput
+    dcSendConsoleInput,
+    dcSendSignal
     );
   TDBGCommands = set of TDBGCommand;
 
@@ -1842,6 +1843,7 @@
     // prevent destruction while nested in any call
     procedure LockRelease; virtual;
     procedure UnlockRelease; virtual;
+    function GetPseudoTerminal: TPseudoTerminal; virtual;
   public
     class function Caption: String; virtual;         // The name of the debugger as shown in the debuggeroptions
     class function ExePaths: String; virtual;        // The default locations of the exe
@@ -1913,6 +1915,7 @@
     property Registers: TRegisterSupplier read FRegisters;                           // list of all registers
     property Signals: TDBGSignals read FSignals;                                 // A list of actions for signals we know
     property ShowConsole: Boolean read FShowConsole write FShowConsole;          // Indicates if the debugger should create a console for the debuggee
+    property PseudoTerminal: TPseudoTerminal read GetPseudoTerminal; experimental; // 'may be replaced with a more general API';
     property State: TDBGState read FState;                                       // The current state of the debugger
     property SupportedCommands: TDBGCommands read GetSupportedCommands;          // All available commands of the debugger
     property TargetWidth: Byte read GetTargetWidth;                              // Currently only 32 or 64
@@ -2001,11 +2004,11 @@
              dcSendConsoleInput],
   {dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcStepOverInstr, dcStepIntoInstr,
              dcStepOut, dcRunTo, dcJumpto, dcDetach, dcBreak, dcWatch, dcLocal, dcEvaluate, dcModify,
-             dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput],
+             dcEnvironment, dcSetStackFrame, dcDisassemble, dcSendConsoleInput, dcSendSignal],
   {dsInternalPause} // same as run, so not really used
-            [dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
+            [dcStop, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput, dcSendSignal],
   {dsInit } [],
-  {dsRun  } [dcPause, dcStop, dcDetach, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput],
+  {dsRun  } [dcPause, dcStop, dcDetach, dcBreak, dcWatch, dcEnvironment, dcSendConsoleInput, dcSendSignal],
   {dsError} [dcStop],
   {dsDestroying} []
   );
@@ -5857,6 +5860,11 @@
   FCurEnvironment.Assign(FEnvironment);
 end;
 
+function TDebuggerIntf.GetPseudoTerminal: TPseudoTerminal;
+begin
+  Result := nil;
+end;
+
 //function TDebuggerIntf.GetUnitInfoProvider: TDebuggerUnitInfoProvider;
 //begin
 //  Result := FUnitInfoProvider;
Index: components/debuggerintf/dbgintfpseudoterminal.pas
===================================================================
--- components/debuggerintf/dbgintfpseudoterminal.pas	(nonexistent)
+++ components/debuggerintf/dbgintfpseudoterminal.pas	(working copy)
@@ -0,0 +1,208 @@
+{            ----------------------------------------------------
+              DbgIntfPsuedoTerminal.pp  -  Debugger helper class
+             ----------------------------------------------------
+
+  This unit contains a helper class for a console containing a program being debugged.
+
+
+ ***************************************************************************
+ *                                                                         *
+ *   This source 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 code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
+ *                                                                         *
+ ***************************************************************************
+}
+
+unit DbgIntfPseudoTerminal;
+
+{$mode objfpc}{$H+}
+{$IFDEF linux} {$DEFINE DBG_ENABLE_TERMINAL} {$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+{$IFDEF DBG_ENABLE_TERMINAL}
+IDEMiniLibC, BaseUnix;
+{$ENDIF}
+
+{$IFDEF DBG_ENABLE_TERMINAL}
+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 DevicePtyMaster: integer read FPty;
+  property Devicename: string read FDeviceName;
+end;
+{$ENDIF}
+
+
+implementation
+
+{$IFDEF DBG_ENABLE_TERMINAL}
+
+{ 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 __Close(FPTy);
+  FPTy := InvalHandle;
+end;
+
+procedure TPseudoTerminal.Open;
+const
+  BufLen = 100;
+var
+  ios: termios;
+  int1: integer;
+
+  procedure Error;
+  begin
+    if FPTy <> InvalHandle
+    then __Close(FPTy);
+    FPTy := InvalHandle;
+    FDeviceName := '';
+  end;
+
+begin
+  Close;
+  FPTy := getpt;
+  if FPTy < 0 then Error;
+  if (grantpt(FPTy) < 0) or (unlockpt(FPTy) < 0) then begin
+    Error;
+    exit;
+  end;
+  setlength(FDeviceName, BufLen);
+  if ptsname_r(FPTy, @FDeviceName[1], BufLen) < 0 then begin
+    Error;
+    exit;
+  end;
+  setlength(FDeviceName,length(pchar(FDeviceName)));
+  if tcgetattr(FPTy, @ios) <> 0 then begin
+    Error;
+    exit;
+  end;
+  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 begin
+    Error;
+    exit;
+  end;
+
+  int1 := fcntl(FPTy, f_getfl, 0);
+  if int1 = InvalHandle then begin
+    Error;
+    exit;
+  end;
+  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 := __write(FPTy, p^, nbytes);
+    if int1 = -1 then begin
+      if 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
+  if (FPTy = InvalHandle) then exit('');
+
+  SetLength(buf, BufLen + 1);
+  Result := FReadBuf;
+  FReadBuf := '';
+  repeat
+    i := __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.
+
Index: components/debuggerintf/debuggerintf.lpk
===================================================================
--- components/debuggerintf/debuggerintf.lpk	(revision 58442)
+++ components/debuggerintf/debuggerintf.lpk	(working copy)
@@ -27,7 +27,7 @@
 Provides an interface to add debuggers to the IDE"/>
     <License Value="GPL-2"/>
     <Version Minor="1"/>
-    <Files Count="3">
+    <Files Count="5">
       <Item1>
         <Filename Value="dbgintfbasetypes.pas"/>
         <UnitName Value="DbgIntfBaseTypes"/>
@@ -40,6 +40,14 @@
         <Filename Value="dbgintfmiscclasses.pas"/>
         <UnitName Value="DbgIntfMiscClasses"/>
       </Item3>
+      <Item4>
+        <Filename Value="ideminilibc.pas"/>
+        <UnitName Value="IDEMiniLibC"/>
+      </Item4>
+      <Item5>
+        <Filename Value="dbgintfpseudoterminal.pas"/>
+        <UnitName Value="dbgintfpseudoterminal"/>
+      </Item5>
     </Files>
     <RequiredPkgs Count="1">
       <Item1>
Index: components/debuggerintf/debuggerintf.pas
===================================================================
--- components/debuggerintf/debuggerintf.pas	(revision 58442)
+++ components/debuggerintf/debuggerintf.pas	(working copy)
@@ -8,7 +8,8 @@
 interface
 
 uses
-  DbgIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfMiscClasses, LazarusPackageIntf;
+  DbgIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfMiscClasses, IDEMiniLibC, 
+  DbgIntfPseudoTerminal, LazarusPackageIntf;
 
 implementation
 
Index: components/lazdebuggergdbmi/gdbmidebugger.pp
===================================================================
--- components/lazdebuggergdbmi/gdbmidebugger.pp	(revision 58442)
+++ components/lazdebuggergdbmi/gdbmidebugger.pp	(working copy)
@@ -65,7 +65,7 @@
   LazFileUtils,
   {$ENDIF}
   DebugUtils, GDBTypeInfo, GDBMIDebugInstructions, GDBMIMiscClasses,
-  DbgIntfBaseTypes, DbgIntfDebuggerBase, GdbmiStringConstants;
+  DbgIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfPseudoTerminal, GdbmiStringConstants;
 
 type
   TGDBMIProgramInfo = record
@@ -860,6 +860,7 @@
     {$IFDEF DBG_ENABLE_TERMINAL}
     FPseudoTerminal: TPseudoTerminal;
     procedure ProcessWhileWaitForHandles; override;
+    function GetPseudoTerminal: TPseudoTerminal; override;
     {$ENDIF}
     procedure QueueExecuteLock;
     procedure QueueExecuteUnlock;
@@ -8909,6 +8910,7 @@
       {$IFDEF DBG_ENABLE_TERMINAL}
       dcSendConsoleInput: FPseudoTerminal.Write(String(AParams[0].VAnsiString));
       {$ENDIF}
+      dcSendSignal: ; // kill(FTargetInfo, AParams[1]);
     end;
   finally
     UnlockRelease;
@@ -9005,6 +9007,11 @@
   inherited ProcessWhileWaitForHandles;
   FPseudoTerminal.CheckCanRead;
 end;
+
+function TGDBMIDebugger.GetPseudoTerminal: TPseudoTerminal;
+begin
+  Result := FPseudoTerminal;
+end;
 {$ENDIF}
 
 procedure TGDBMIDebugger.QueueExecuteLock;
Index: components/lazdebuggergdbmi/gdbmimiscclasses.pp
===================================================================
--- components/lazdebuggergdbmi/gdbmimiscclasses.pp	(revision 58442)
+++ components/lazdebuggergdbmi/gdbmimiscclasses.pp	(working copy)
@@ -27,16 +27,11 @@
 
 unit GDBMIMiscClasses;
 {$mode objfpc}{$H+}
-{$IFDEF linux} {$DEFINE DBG_ENABLE_TERMINAL} {$ENDIF}
 
 interface
 
 uses
-  SysUtils,
-  {$IFDEF DBG_ENABLE_TERMINAL}
-  IDEMiniLibC, BaseUnix, Classes,
-  {$ENDIF}
-  DebugUtils, DbgIntfDebuggerBase;
+    Classes, SysUtils, DebugUtils, DbgIntfDebuggerBase;
 
 type
 
@@ -104,32 +99,7 @@
     property Text: String read GetText;
   end;
 
-  {$IFDEF DBG_ENABLE_TERMINAL}
-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 }
@@ -451,141 +421,6 @@
   Result := -1;
 end;
 
-{$IFDEF DBG_ENABLE_TERMINAL}
 
-{ 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 __Close(FPTy);
-  FPTy := InvalHandle;
-end;
-
-procedure TPseudoTerminal.Open;
-const
-  BufLen = 100;
-var
-  ios: termios;
-  int1: integer;
-
-  procedure Error;
-  begin
-    if FPTy <> InvalHandle
-    then __Close(FPTy);
-    FPTy := InvalHandle;
-    FDeviceName := '';
-  end;
-
-begin
-  Close;
-  FPTy := getpt;
-  if FPTy < 0 then Error;
-  if (grantpt(FPTy) < 0) or (unlockpt(FPTy) < 0) then begin
-    Error;
-    exit;
-  end;
-  setlength(FDeviceName, BufLen);
-  if ptsname_r(FPTy, @FDeviceName[1], BufLen) < 0 then begin
-    Error;
-    exit;
-  end;
-  setlength(FDeviceName,length(pchar(FDeviceName)));
-  if tcgetattr(FPTy, @ios) <> 0 then begin
-    Error;
-    exit;
-  end;
-  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 begin
-    Error;
-    exit;
-  end;
-
-  int1 := fcntl(FPTy, f_getfl, 0);
-  if int1 = InvalHandle then begin
-    Error;
-    exit;
-  end;
-  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 := __write(FPTy, p^, nbytes);
-    if int1 = -1 then begin
-      if 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
-  if (FPTy = InvalHandle) then exit('');
-
-  SetLength(buf, BufLen + 1);
-  Result := FReadBuf;
-  FReadBuf := '';
-  repeat
-    i := __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.
 
Index: components/lazdebuggergdbmi/lazdebuggergdbmi.lpk
===================================================================
--- components/lazdebuggergdbmi/lazdebuggergdbmi.lpk	(revision 58442)
+++ components/lazdebuggergdbmi/lazdebuggergdbmi.lpk	(working copy)
@@ -20,7 +20,7 @@
 This debugger uses gdb and is based on gdb's mi interface."/>
     <License Value="GPL"/>
     <Version Minor="1"/>
-    <Files Count="10">
+    <Files Count="9">
       <Item1>
         <Filename Value="cmdlinedebugger.pp"/>
         <UnitName Value="CmdLineDebugger"/>
@@ -38,32 +38,28 @@
         <UnitName Value="GDBMIMiscClasses"/>
       </Item4>
       <Item5>
-        <Filename Value="ideminilibc.pas"/>
-        <UnitName Value="IDEMiniLibC"/>
-      </Item5>
-      <Item6>
         <Filename Value="gdbmidebugger.pp"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="GDBMIDebugger"/>
+      </Item5>
+      <Item6>
+        <Filename Value="gdbmidebuginstructions.pp"/>
+        <UnitName Value="GDBMIDebugInstructions"/>
       </Item6>
       <Item7>
-        <Filename Value="gdbmidebuginstructions.pp"/>
-        <UnitName Value="GDBMIDebugInstructions"/>
-      </Item7>
-      <Item8>
         <Filename Value="gdbmiserverdebugger.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="GDBMIServerDebugger"/>
-      </Item8>
-      <Item9>
+      </Item7>
+      <Item8>
         <Filename Value="sshgdbmidebugger.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="SSHGDBMIDebugger"/>
-      </Item9>
-      <Item10>
+      </Item8>
+      <Item9>
         <Filename Value="gdbmistringconstants.pas"/>
         <UnitName Value="GdbmiStringConstants"/>
-      </Item10>
+      </Item9>
     </Files>
     <i18n>
       <EnableI18N Value="True"/>
Index: components/lazdebuggergdbmi/lazdebuggergdbmi.pas
===================================================================
--- components/lazdebuggergdbmi/lazdebuggergdbmi.pas	(revision 58442)
+++ components/lazdebuggergdbmi/lazdebuggergdbmi.pas	(working copy)
@@ -8,9 +8,9 @@
 interface
 
 uses
-  CmdLineDebugger, DebugUtils, GDBTypeInfo, GDBMIMiscClasses, IDEMiniLibC, 
-  GDBMIDebugger, GDBMIDebugInstructions, GDBMIServerDebugger, 
-  SSHGDBMIDebugger, GdbmiStringConstants, LazarusPackageIntf;
+  CmdLineDebugger, DebugUtils, GDBTypeInfo, GDBMIMiscClasses, GDBMIDebugger, 
+  GDBMIDebugInstructions, GDBMIServerDebugger, SSHGDBMIDebugger, 
+  GdbmiStringConstants, LazarusPackageIntf;
 
 implementation
 
Index: debugger/debugger.pp
===================================================================
--- debugger/debugger.pp	(revision 58442)
+++ debugger/debugger.pp	(working copy)
@@ -1743,7 +1743,8 @@
     'Disassemble',
     'StepOverInstr',
     'StepIntoInstr',
-    'SendConsoleInput'
+    'SendConsoleInput',
+    'SendSignal'
     );
 
   DBGStateNames: array[TDBGState] of string = (
Index: debugger/pseudoterminaldlg.lfm
===================================================================
--- debugger/pseudoterminaldlg.lfm	(revision 58442)
+++ debugger/pseudoterminaldlg.lfm	(working copy)
@@ -1,9 +1,15 @@
-inherited PseudoConsoleDlg: TPseudoConsoleDlg
-  Left = 1261
-  Top = 344
+object PseudoConsoleDlg: TPseudoConsoleDlg
+  Left = 697
+  Height = 240
+  Top = 327
+  Width = 320
   Caption = 'Console'
+  ClientHeight = 240
+  ClientWidth = 320
   DockSite = True
-  object Memo1: TMemo[0]
+  OnResize = FormResize
+  LCLVersion = '1.9.0.0'
+  object Memo1: TMemo
     Left = 0
     Height = 240
     Top = 0
Index: debugger/pseudoterminaldlg.pp
===================================================================
--- debugger/pseudoterminaldlg.pp	(revision 58442)
+++ debugger/pseudoterminaldlg.pp	(working copy)
@@ -1,3 +1,31 @@
+{              ------------------------------------------------
+                PseudoTerminalDlg.pp  -  Debugger helper class
+               ------------------------------------------------
+
+  This unit supports a form with a window acting as the console of a
+  program being debugged, in particular in manages resize events.
+
+
+ ***************************************************************************
+ *                                                                         *
+ *   This source 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 code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
+ *                                                                         *
+ ***************************************************************************
+}
+
 unit PseudoTerminalDlg;
 
 {$mode objfpc}{$H+}
@@ -14,9 +42,17 @@
 
   TPseudoConsoleDlg = class(TDebuggerDlg)
     Memo1: TMemo;
+    procedure FormResize(Sender: TObject);
     procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
   private
     { private declarations }
+    ttyHandle: THandle;         (* Used only by unix for console size tracking  *)
+    fCharHeight: word;
+    fCharWidth: word;
+    fRowsPerScreen: integer;
+    fColsPerRow: integer;
+    procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
+    procedure consoleSizeChanged;
   protected
     procedure DoClose(var CloseAction: TCloseAction); override;
   public
@@ -24,15 +60,29 @@
     constructor Create(TheOwner: TComponent); override;
     procedure AddOutput(const AText: String);
     procedure Clear;
+    property CharHeight: word read fCharHeight;
+    property CharWidth: word read fCharWidth;
+    property RowsPerScreen: integer read fRowsPerScreen;
+    property ColsPerRow: integer read fColsPerRow;
   end;
 
 var
   PseudoConsoleDlg: TPseudoConsoleDlg;
 
+
 implementation
 
+uses
+  SysUtils, LazLoggerBase,
+{$IFDEF UNIX}
+  Unix, BaseUnix, termio;
+{$ENDIF UNIX}
+
+const
+  handleUnopened= THandle(-$80000000);
+
 var
-  PseudeoTerminalDlgWindowCreator: TIDEWindowCreator;
+  PseudoTerminalDlgWindowCreator: TIDEWindowCreator;
 
 { TPseudoConsoleDlg }
 
@@ -43,8 +93,49 @@
   Utf8Key := '';
 end;
 
+
+(* The form size has changed. Call a procedure to pass this to the kernel etc.,
+  assuming that this works out the best control to track.
+*)
+procedure TPseudoConsoleDlg.FormResize(Sender: TObject);
+
+var
+  ttyNotYetInitialised: boolean;
+
+begin
+
+(* These are not errors so much as conditions we will see while the IDE is      *)
+(* starting up.                                                                 *)
+
+  if DebugBoss = nil then
+    exit;
+  if DebugBoss.Debugger = nil then
+    exit;
+  if DebugBoss.Debugger.PseudoTerminal = nil then
+    exit;
+
+(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
+(* so while we prefer success we also consider that failure /is/ an acceptable  *)
+(* option in this case.                                                         *)
+
+  ttyNotYetInitialised := ttyHandle = handleUnopened;
+  DebugLn(['TPseudoConsoleDlg.FormResize Calling consoleSizeChanged']);
+  consoleSizeChanged;
+  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
+    DebugLn(['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
+    ttyHandle := handleUnopened
+  end
+end;
+
+
 procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
 begin
+{$IFDEF UNIX}
+  if integer(ttyHandle) >= 0 then begin
+    FileClose(ttyHandle);
+    ttyHandle := handleUnopened
+  end;
+{$ENDIF UNIX}
   inherited DoClose(CloseAction);
   CloseAction := caHide;
 end;
@@ -54,18 +145,158 @@
   inherited Create(TheOwner);
   font.Name := 'monospace';
   Caption:= lisDbgTerminal;
+  ttyHandle := handleUnopened;
+  fRowsPerScreen := -1;
+  fColsPerRow := -1
 end;
 
+
+(* Get the height and width for characters described by the fount specified by
+  the first parameter. This will normally be monospaced, but in case it's not
+  use "W" which is normally the widest character in a typeface so that a
+  subsequent conversion from a window size in pixels to one in character cells
+  errs on the side of fewer rather than more rows and columns.
+*)
+procedure TPseudoConsoleDlg.getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
+
+var
+  bm: TBitMap;
+
+begin
+  bm := TBitmap.Create;
+  try
+    bm.Canvas.Font.Assign(consoleFont);
+    h := bm.Canvas.TextHeight('W');
+    w := bm.Canvas.TextWidth('W')
+  finally
+    bm.Free
+  end
+end;
+
+
+(* Assume that the console size has changed, either because it's just starting
+  to be used or because a window has been resized. Use an ioctl() to tell a TTY
+  to reconsider its opinion of itself, and if necessary send an explicit signal
+  to the process being debugged. Assume that this is peculiar to unix-like OSes,
+  but may be called safely by others.
+*)
+procedure TPseudoConsoleDlg.consoleSizeChanged;
+
+{$IFDEF UNIX }
+{ DEFINE USE_SLAVE_HANDLE }
+{ DEFINE SEND_EXPLICIT_SIGNAL }
+
+var
+{$IFDEF USE_SLAVE_HANDLE }
+  s: string;
+{$ENDIF USE_SLAVE_HANDLE }
+  winSize: TWinSize;
+
+begin
+  if ttyHandle = handleUnopened then
+
+(* Assume that we get here when the first character is to be written by the     *)
+(* program being debugged, and that the form and memo are fully initialised.    *)
+(* Leave ttyHandle either open (i.e. >= 0) or -ve but no longer handleUnopened, *)
+(* in the latter case no further attempt will be made to use it.                *)
+
+// Requires -dDBG_WITH_DEBUGGER_DEBUG
+
+    if DebugBoss.Debugger.PseudoTerminal <> nil then begin
+      DebugLn(['TPseudoConsoleDlg.AddOutput PseudoTerminal.DevicePtyMaster=',
+                        DebugBoss.Debugger.PseudoTerminal.DevicePtyMaster]);
+{$IFDEF USE_SLAVE_HANDLE }
+      s := DebugBoss.Debugger.PseudoTerminal.Devicename;
+      DebugLn(['TPseudoConsoleDlg.AddOutput PseudoTerminal.Devicename="', s, '"']);
+      ttyHandle := fileopen(s, fmOpenWrite)
+{$ELSE                   }
+      ttyHandle := DebugBoss.Debugger.PseudoTerminal.DevicePtyMaster;
+{$ENDIF USE_SLAVE_HANDLE }
+      DebugLn(['TPseudoConsoleDlg.AddOutput ttyHandle=', ttyHandle]);
+      getCharHeightAndWidth(Memo1.Font, fCharHeight, fCharWidth)
+    end else begin                      (* Can't get pseudoterminal             *)
+      DebugLn(['TPseudoConsoleDlg.AddOutput Unopened -> bad PseudoTerminal']);
+      ttyHandle := THandle(-1)
+    end;
+
+(* Every time we're called, provided that we were able to open the TTY, work    *)
+(* out the window size and tell the kernel and/or process.                      *)
+
+  if integer(ttyHandle) >= 0 then begin (* Got slave TTY name and valid handle  *)
+    with winSize do begin
+      ws_xpixel := Memo1.Width;
+      ws_ypixel := Memo1.Height;      (* Assume the fount is monospaced         *)
+      ws_row := ws_ypixel div fCharHeight;
+      ws_col := ws_xpixel div fCharwidth;
+      DebugLn(['TPseudoConsoleDlg.AddOutput (rows x cols)=(', ws_row, ' x ', ws_col, ')']);
+
+(* TIOCGWINSZ reports the console size in both character cells and pixels, but  *)
+(* since we're not likely to be emulating e.g. a Tektronix terminal or one of   *)
+(* the higher-end DEC ones it's reasonable to bow out here if the size hasn't   *)
+(* changed by at least a full row or character.                                 *)
+
+      if (ws_row = fRowsPerScreen) and (ws_col = fColsPerRow) then
+        exit;
+      fRowsPerScreen := ws_row;
+      fColsPerRow := ws_col
+    end;
+
+(* Note that when the Linux kernel (or appropriate driver etc.) gets TIOCSWINSZ *)
+(* it takes it upon itself to raise a SIGWINCH, I've not tested whether other   *)
+(* unix implementations do the same. Because this is an implicit action, and    *)
+(* because by and large the process receiving the signal can identify the       *)
+(* sender and would be entitled to be unhappy if the sender appeared to vary,   *)
+(* I've not attempted to defer signal sending in cases where the process being  *)
+(* debugged is in a paused state or is otherwise suspected to not be able to    *)
+(* handle it immediately. MarkMLl (so you know who to kick).                    *)
+
+    if fpioctl(ttyHandle, TIOCSWINSZ, @winSize) < 0 then begin
+      fileclose(ttyHandle);
+      DebugLn(['TPseudoConsoleDlg.AddOutput Write failed, closed handle']);
+      ttyHandle := THandle(-1)      (* Attempted ioctl() failed                 *)
+    end;
+    if integer(ttyHandle) >= 0 then begin (* Handle not closed by error         *)
+{$IFDEF SEND_EXPLICIT_SIGNAL }
+{$WARNING TPseudoConsoleDlg.consoleSizeChanged: Explicit signal untested }
+
+// If I'm reading things correctly ReqCmd() is private, so this needs fettling.
+
+      DebugBoss.Debugger.ReqCmd(dcSendSignal, [SIGWINCH]);
+{$ENDIF SEND_EXPLICIT_SIGNAL }
+      FillChar(winSize, sizeof(winSize), 0); (* Did it work?                    *)
+      fpioctl(ttyHandle, TIOCGWINSZ, @winSize);
+      DebugLn(['TPseudoConsoleDlg.AddOutput readback=(', winSize.ws_row, ' x ', winSize.ws_col, ')'])
+    end
+  end;
+{$ELSE       }
+begin
+  ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
+{$ENDIF UNIX }
+  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
+end;
+
+
 procedure TPseudoConsoleDlg.AddOutput(const AText: String);
+
 begin
-  Memo1.Text:=Memo1.Text+AText;
+  if ttyHandle = handleUnopened then begin (* Do this at first output only      *)
+    DebugLn(['TPseudoConsoleDlg.AddOutput Calling consoleSizeChanged']);
+    consoleSizeChanged
+  end;
   while Memo1.Lines.Count > 5000 do
     Memo1.Lines.Delete(0);
+
+// Working note: make any adjustment to the number of lines etc. before we
+// start to add text which might include escape handling.
+
+  Memo1.Text:=Memo1.Text+AText;
   Memo1.SelStart := length(Memo1.Text);
 end;
 
 procedure TPseudoConsoleDlg.Clear;
 begin
+  DebugLn(['TPseudoConsoleDlg.Clear Calling FormResize']);
+  FormResize(nil);                      (* Safe during IDE initialisation       *)
   Memo1.Text := '';
 end;
 
@@ -73,9 +304,9 @@
 
 initialization
 
-  PseudeoTerminalDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtPseudoTerminal]);
-  PseudeoTerminalDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
-  PseudeoTerminalDlgWindowCreator.CreateSimpleLayout;
+  PseudoTerminalDlgWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtPseudoTerminal]);
+  PseudoTerminalDlgWindowCreator.OnCreateFormProc := @CreateDebugDialog;
+  PseudoTerminalDlgWindowCreator.CreateSimpleLayout;
 
 end.
 
Index: debugger/test/watchconsolesize.lpi
===================================================================
--- debugger/test/watchconsolesize.lpi	(nonexistent)
+++ debugger/test/watchconsolesize.lpi	(working copy)
@@ -0,0 +1,53 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="My Application"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="watchconsolesize.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="WatchConsoleSize"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="watchconsolesize"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
Index: debugger/test/watchconsolesize.pas
===================================================================
--- debugger/test/watchconsolesize.pas	(nonexistent)
+++ debugger/test/watchconsolesize.pas	(working copy)
@@ -0,0 +1,67 @@
+program WatchConsoleSize;
+
+(* This console-mode program for Linux or other unix implementations reports	*)
+(* on the initial console size and outputs a message every time it gets a	*)
+(* SIGWINCH indicating that the console window has been resized.		*)
+(*										*)
+(* It DOES NOT attempt any formatted output using escape sequences etc. MarkMLl	*)
+
+uses
+  SysUtils, Keyboard, Crt, TermIO, BaseUnix;
+
+var
+  signalCount: integer= 0;
+
+
+procedure reportSize;
+
+var
+  winSize: TWinSize;
+
+begin
+  Write(signalCount, ': ');
+  FillChar(winSize, sizeof(winSize), 0);
+  if IsaTty(StdInputHandle) = 1 then
+    if fpioctl(StdInputHandle, TIOCGWINSZ, @winSize) >= 0 then
+      Write(winSize.ws_row, ' x ', winSize.ws_col);
+  WriteLn;
+  signalCount += 1
+end { reportSize } ;
+
+
+procedure winchHandler(sig: longint; {%H-}info: PSigInfo; {%H-}context: PSigContext); cdecl;
+
+begin
+  case sig of
+    SIGWINCH: reportSize
+  otherwise
+  end
+end { winchHandler } ;
+
+
+function hookWinch(): boolean;
+
+var
+  action: SigActionRec;
+
+begin
+  FillChar(action{%H-}, SizeOf(action), 0);
+  action.Sa_Handler := @winchHandler;
+  action.Sa_Flags := SA_SIGINFO;
+  hookWinch := fpSigAction(SIGWINCH, @action, nil) = 0
+end { hookWinch } ;
+
+
+begin
+  WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
+  reportSize;
+  if not hookWinch() then
+    WriteLn('Failed: SIGWINCH not hooked, error ', fpGetErrNo)
+  else begin
+    while not KeyPressed() do
+      Sleep(10);
+    ReadKey
+  end;
+  WriteLn('It ends here.')
+end.
+  
Index: ide/lazarus.lpi
===================================================================
--- ide/lazarus.lpi	(revision 58442)
+++ ide/lazarus.lpi	(working copy)
@@ -39,7 +39,9 @@
     </PublishOptions>
     <RunParams>
       <FormatVersion Value="2"/>
-      <Modes Count="0"/>
+      <Modes Count="1">
+        <Mode0 Name="default"/>
+      </Modes>
     </RunParams>
     <RequiredPackages Count="7">
       <Item1>
@@ -1427,9 +1429,12 @@
     <SearchPaths>
       <IncludeFiles Value="include"/>
       <OtherUnitFiles Value="frames;../converter;../debugger;../debugger/frames;../packager;../designer;../packager/frames;../ide"/>
-      <UnitOutputDirectory Value="$(LazarusDir)/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
+      <UnitOutputDirectory Value="/usr/local/share/lazarus-trunk2/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
     </SearchPaths>
-    <CompileReasons Compile="False" Build="False" Run="False"/>
+    <Other>
+      <CustomOptions Value="-dDBG_WITH_DEBUGGER_DEBUG"/>
+    </Other>
+    <CompileReasons Run="False"/>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="2">
Index: ide/lazarus.res
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream

Mark Morgan Lloyd

2018-07-07 16:55

reporter   ~0109279

Patch uploaded, includes test program.

I'll take a look at at least partial ANSI terminal emulation, but it won't be immediate.

Martin Friebe

2018-07-10 17:44

manager   ~0109347

Patch applied. revision 58480

- Minor fixes to compile on Windows.
- Changed Memo.Width to Memo.ClientWidth (but even that seems to include scrollbars, so results are off by 1 or 2 chars.
- Introduced DebugBoss.PseudoTerminal
- Commented out unused dcSendSignal (from my patch)

Added you to Contributors.txt


I applied the patch as it is working, and I did not want to send forth and back patches of this size.

Maybe code acting on ttyHandle / using fpioctl etc, could be moved inside PseudoTerminal. (This may require the dummy terminal to have empty methods of the same name)
This may reduce the IFDEF amount in PseudoTerminalDlg.

You may also want to see, if a better result for ClientWidth can be obtained (on fedora it seems to include the scrollbar)

Martin Friebe

2018-07-10 17:52

manager   ~0109348

I moved the debug output to the "IDE internals" menu. It is only for debugging the debugger, and not for the average user. (unless he is told to provide such feedback)

Mark Morgan Lloyd

2018-07-10 19:55

reporter   ~0109350

Last edited: 2018-07-10 20:21

View 2 revisions

Thanks. I'll start tinkering a bit with an initially-hidden formatted output control, possibly with reference to "Tito's Terminal" which is based on Synedit. The first job as I see it is just enough terminal emulation to put markers at the top-left and bottom right, which should be enough to tune the height and width assumptions.

To save batting a trivial patch around, please check line 206 in pseudoterminaldlg.pp where only the first part of a two-line comment has had // applied.

Martin Friebe

2018-07-10 22:25

manager   ~0109353

Thanks, fixed the comment. (Result of testing and moving between 2 OS)

Mark Morgan Lloyd

2018-07-11 21:45

reporter   ~0109376

Would you expect the AText parameter of AddOutput() to represent a single or multiple lines? Just checking before I make any assumptions.

Martin Friebe

2018-07-11 22:57

manager   ~0109380

At the moment it gets whatever TPseudoTerminal.Read returns. I am not sure of that.
But other debuggers, may get output in other ways. Also it is lacking implementation for MacOs, and could be different there.

I would think it is save to say it might get multiple lines. (Though for now if TPseudoTerminal.Read can be guranteed, then that would be ok too)

Mark Morgan Lloyd

2018-07-11 23:52

reporter   ~0109384

Makes sense. There was an odd situation where once the memo enabled its scroll bar output was doublespaced. I was able to improve that a bit but I was still getting extra spacing when output was generated rapidly, i.e. when (according to your explanation) TPseudoTerminal.Read returned multiple concatenated lines.

I'm concentrating on displaying what's actually arriving, which hopefully will throw light on what's happening elsewhere.

Mark Morgan Lloyd

2018-07-13 13:00

reporter  

debug-console-unformatted.diff (32,913 bytes)
Index: debugger/pseudoterminaldlg.lfm
===================================================================
--- debugger/pseudoterminaldlg.lfm	(revision 58484)
+++ debugger/pseudoterminaldlg.lfm	(working copy)
@@ -1,24 +1,210 @@
 object PseudoConsoleDlg: TPseudoConsoleDlg
-  Left = 697
-  Height = 240
-  Top = 327
-  Width = 320
+  Left = 438
+  Height = 480
+  Top = 321
+  Width = 800
   Caption = 'Console'
-  ClientHeight = 240
-  ClientWidth = 320
+  ClientHeight = 480
+  ClientWidth = 800
   DockSite = True
   OnResize = FormResize
   LCLVersion = '1.9.0.0'
-  object Memo1: TMemo
+  object PageControl1: TPageControl
     Left = 0
-    Height = 240
+    Height = 460
     Top = 0
-    Width = 320
+    Width = 800
+    ActivePage = TabSheetRaw
     Align = alClient
-    OnUTF8KeyPress = Memo1UTF8KeyPress
-    ReadOnly = True
-    ScrollBars = ssAutoBoth
+    TabIndex = 1
     TabOrder = 0
-    WantTabs = True
+    object TabSheet1: TTabSheet
+      Caption = 'Formatted'
+      ClientHeight = 430
+      ClientWidth = 790
+      TabVisible = False
+      object Panel1: TPanel
+        Left = 470
+        Height = 430
+        Top = 0
+        Width = 160
+        Align = alRight
+        Caption = 'Panel1'
+        TabOrder = 0
+      end
+    end
+    object TabSheetRaw: TTabSheet
+      Caption = 'Raw Output'
+      ClientHeight = 430
+      ClientWidth = 790
+      object PairSplitterRaw: TPairSplitter
+        Left = 0
+        Height = 430
+        Top = 0
+        Width = 790
+        Align = alClient
+        Position = 600
+        object PairSplitterRawLeft: TPairSplitterSide
+          Cursor = crArrow
+          Left = 0
+          Height = 430
+          Top = 0
+          Width = 600
+          ClientWidth = 600
+          ClientHeight = 430
+          object Memo1: TMemo
+            Left = 4
+            Height = 422
+            Top = 4
+            Width = 592
+            Align = alClient
+            BorderSpacing.Around = 4
+            Font.Name = 'Monospace'
+            OnUTF8KeyPress = Memo1UTF8KeyPress
+            ParentFont = False
+            ReadOnly = True
+            ScrollBars = ssAutoBoth
+            TabOrder = 0
+            WantTabs = True
+          end
+        end
+        object PairSplitterRawRight: TPairSplitterSide
+          Cursor = crArrow
+          Left = 605
+          Height = 430
+          Top = 0
+          Width = 185
+          ClientWidth = 185
+          ClientHeight = 430
+          OnResize = PairSplitterRawRightResize
+          object RadioGroupRight: TRadioGroup
+            Left = 0
+            Height = 103
+            Top = 0
+            Width = 185
+            Align = alTop
+            AutoFill = True
+            AutoSize = True
+            Caption = 'Output Style'
+            ChildSizing.LeftRightSpacing = 6
+            ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+            ChildSizing.EnlargeVertical = crsHomogenousChildResize
+            ChildSizing.ShrinkHorizontal = crsScaleChilds
+            ChildSizing.ShrinkVertical = crsScaleChilds
+            ChildSizing.Layout = cclLeftToRightThenTopToBottom
+            ChildSizing.ControlsPerLine = 1
+            ClientHeight = 84
+            ClientWidth = 183
+            ItemIndex = 0
+            Items.Strings = (
+              'Unformatted'
+              'C0 as Control Pictures'
+              'C0 as ISO 2047'
+              'Hex + ASCII'
+            )
+            OnSelectionChanged = RadioGroupRightSelectionChanged
+            TabOrder = 1
+          end
+          object PanelRightBelowRG: TPanel
+            Left = 0
+            Height = 327
+            Top = 103
+            Width = 185
+            Align = alClient
+            BevelOuter = bvNone
+            ClientHeight = 327
+            ClientWidth = 185
+            TabOrder = 0
+            object CheckGroupRight: TCheckGroup
+              Left = 0
+              Height = 73
+              Top = 0
+              Width = 185
+              Align = alTop
+              AutoFill = True
+              AutoSize = True
+              Caption = 'Decorations'
+              ChildSizing.LeftRightSpacing = 6
+              ChildSizing.TopBottomSpacing = 6
+              ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+              ChildSizing.EnlargeVertical = crsHomogenousChildResize
+              ChildSizing.ShrinkHorizontal = crsScaleChilds
+              ChildSizing.ShrinkVertical = crsScaleChilds
+              ChildSizing.Layout = cclLeftToRightThenTopToBottom
+              ChildSizing.ControlsPerLine = 1
+              ClientHeight = 54
+              ClientWidth = 183
+              Enabled = False
+              Items.Strings = (
+                'Line numbers'
+                'C1 as C0 + Underbar'
+              )
+              TabOrder = 1
+              Data = {
+                020000000202
+              }
+            end
+            object PanelRightBelowCG: TPanel
+              Left = 0
+              Height = 254
+              Top = 73
+              Width = 185
+              Align = alClient
+              BevelOuter = bvNone
+              ClientHeight = 254
+              ClientWidth = 185
+              TabOrder = 0
+              object GroupBoxRight: TGroupBox
+                Left = 0
+                Height = 64
+                Top = 0
+                Width = 185
+                Align = alTop
+                Caption = 'Line limit'
+                ClientHeight = 45
+                ClientWidth = 183
+                TabOrder = 0
+                object MaskEdit1: TMaskEdit
+                  Left = 9
+                  Height = 30
+                  Top = 0
+                  Width = 128
+                  CharCase = ecNormal
+                  MaxLength = 7
+                  TabOrder = 0
+                  EditMask = '#######'
+                  Text = '5000   '
+                  SpaceChar = '_'
+                end
+              end
+            end
+          end
+        end
+      end
+    end
   end
+  object StatusBar1: TStatusBar
+    Left = 0
+    Height = 20
+    Top = 460
+    Width = 800
+    Panels = <    
+      item
+        Text = '    dumb'
+        Width = 160
+      end    
+      item
+        Text = '00 x 00 chars'
+        Width = 160
+      end    
+      item
+        Text = '000 x 000 pixels'
+        Width = 160
+      end    
+      item
+        Text = 'Not resized'
+        Width = 160
+      end>
+    SimplePanel = False
+  end
 end
Index: debugger/pseudoterminaldlg.pp
===================================================================
--- debugger/pseudoterminaldlg.pp	(revision 58484)
+++ debugger/pseudoterminaldlg.pp	(working copy)
@@ -33,8 +33,9 @@
 interface
 
 uses
-  IDEWindowIntf, Classes, Graphics,
-  Forms, StdCtrls, DebuggerDlg, BaseDebugManager, LazarusIDEStrConsts, LCLType;
+  IDEWindowIntf, Classes, Graphics, Forms, StdCtrls, DebuggerDlg,
+  BaseDebugManager, LazarusIDEStrConsts, LCLType, ComCtrls, ExtCtrls, MaskEdit,
+  PairSplitter;
 
 type
 
@@ -41,9 +42,25 @@
   { TPseudoConsoleDlg }
 
   TPseudoConsoleDlg = class(TDebuggerDlg)
+    CheckGroupRight: TCheckGroup;
+    GroupBoxRight: TGroupBox;
+    MaskEdit1: TMaskEdit;
     Memo1: TMemo;
+    PageControl1: TPageControl;
+    PairSplitterRaw: TPairSplitter;
+    PairSplitterRawLeft: TPairSplitterSide;
+    PairSplitterRawRight: TPairSplitterSide;
+    Panel1: TPanel;
+    PanelRightBelowRG: TPanel;
+    PanelRightBelowCG: TPanel;
+    RadioGroupRight: TRadioGroup;
+    StatusBar1: TStatusBar;
+    TabSheet1: TTabSheet;
+    TabSheetRaw: TTabSheet;
     procedure FormResize(Sender: TObject);
     procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
+    procedure PairSplitterRawRightResize(Sender: TObject);
+    procedure RadioGroupRightSelectionChanged(Sender: TObject);
   private
     { private declarations }
     ttyHandle: System.THandle;         (* Used only by unix for console size tracking  *)
@@ -51,6 +68,7 @@
     fCharWidth: word;
     fRowsPerScreen: integer;
     fColsPerRow: integer;
+    fFirstLine: integer;
     procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
     procedure consoleSizeChanged;
   protected
@@ -73,7 +91,7 @@
 implementation
 
 uses
-  SysUtils, LazLoggerBase
+  SysUtils, StrUtils, LazLoggerBase
 {$IFDEF UNIX}
   , Unix, BaseUnix, termio
 {$ENDIF UNIX}
@@ -96,6 +114,50 @@
 end;
 
 
+procedure TPseudoConsoleDlg.PairSplitterRawRightResize(Sender: TObject);
+
+var
+  ttyNotYetInitialised: boolean;
+
+begin
+
+(* These are not errors so much as conditions we will see while the IDE is      *)
+(* starting up.                                                                 *)
+
+  if DebugBoss = nil then
+    exit;
+  if DebugBoss.PseudoTerminal = nil then
+    exit;
+
+(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
+(* so while we prefer success we also consider that failure /is/ an acceptable  *)
+(* option in this case.                                                         *)
+
+  ttyNotYetInitialised := ttyHandle = handleUnopened;
+  //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.SplitterRawRightResize Calling consoleSizeChanged']);
+  consoleSizeChanged;
+  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
+    DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.SplitterRawRightResize Bad PseudoTerminal -> unopened']);
+    ttyHandle := handleUnopened
+  end;
+  StatusBar1.Panels[3].Text := 'Splitter resized'
+end { TPseudoConsoleDlg.PairSplitterRawRightResize } ;
+
+
+(* The C1 underbar decoration is only relevant when C0 is being displayed as
+  control pictures or ISO 2047 glyphs.
+*)
+procedure TPseudoConsoleDlg.RadioGroupRightSelectionChanged(Sender: TObject);
+
+begin
+  case RadioGroupRight.ItemIndex of
+    1, 2: CheckGroupRight.CheckEnabled[1] := true
+  otherwise
+    CheckGroupRight.CheckEnabled[1] := false
+  end
+end { TPseudoConsoleDlg.RadioGroupRightSelectionChanged } ;
+
+
 (* The form size has changed. Call a procedure to pass this to the kernel etc.,
   assuming that this works out the best control to track.
 *)
@@ -124,11 +186,13 @@
   if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
     DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
     ttyHandle := handleUnopened
-  end
-end;
+  end;
+  StatusBar1.Panels[3].Text := 'Window resized'
+end { TPseudoConsoleDlg.FormResize } ;
 
 
 procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
+
 begin
 {$IFDEF UNIX}
   if integer(ttyHandle) >= 0 then begin
@@ -138,9 +202,11 @@
 {$ENDIF UNIX}
   inherited DoClose(CloseAction);
   CloseAction := caHide;
-end;
+end { TPseudoConsoleDlg.DoClose } ;
 
+
 constructor TPseudoConsoleDlg.Create(TheOwner: TComponent);
+
 begin
   inherited Create(TheOwner);
   font.Name := 'monospace';
@@ -147,8 +213,9 @@
   Caption:= lisDbgTerminal;
   ttyHandle := handleUnopened;
   fRowsPerScreen := -1;
-  fColsPerRow := -1
-end;
+  fColsPerRow := -1;
+  fFirstLine := 1
+end { TPseudoConsoleDlg.Create } ;
 
 
 (* Get the height and width for characters described by the fount specified by
@@ -171,7 +238,7 @@
   finally
     bm.Free
   end
-end;
+end { TPseudoConsoleDlg.getCharHeightAndWidth } ;
 
 
 (* Assume that the console size has changed, either because it's just starting
@@ -273,34 +340,413 @@
 begin
   ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
 {$ENDIF UNIX }
-  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
-end;
+  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit');
+  RadioGroupRightSelectionChanged(nil); (* Sort out initial state               *)
+  StatusBar1.Panels[0].Width := Width div 4;
+  StatusBar1.Panels[0].Text := '    ' ; // + DebugBoss.Debugger.Environment.Values['TERM'];
+  StatusBar1.Panels[1].Width := Width div 4;
+  StatusBar1.Panels[1].Text := Format('%d cols x %d rows', [winsize.ws_col, winsize.ws_row]);
+  StatusBar1.Panels[2].Width := Width div 4;
+  StatusBar1.Panels[2].Text := Format('%d x %d pixels', [winsize.ws_xpixel, winsize.ws_ypixel])
+end { TPseudoConsoleDlg.consoleSizeChanged } ;
 
 
 procedure TPseudoConsoleDlg.AddOutput(const AText: String);
 
+var
+  lineLimit, numLength, i: integer;
+  buffer: TStringList;
+
+
+  (* Translate C0 control codes to "control pictures", and optionally C1 codes
+    to the same glyph but with an underbar.
+  *)
+  function withControlPictures(const str: widestring; c1Underbar: boolean): widestring;
+
+  const
+    nul= #$2400;                        // ␀
+    soh= #$2401;                        // ␁
+    stx= #$2402;                        // ␂
+    etx= #$2403;                        // ␃
+    eot= #$2404;                        // ␄
+    enq= #$2405;                        // ␅
+    ack= #$2406;                        // ␆
+    bel= #$2407;                        // ␇
+    bs=  #$2408;                        // ␈
+    ht=  #$2409;                        // ␉
+    lf=  #$240a;                        // ␊
+    vt=  #$240b;                        // ␋
+    ff=  #$240c;                        // ␌
+    cr=  #$240d;                        // ␍
+    so=  #$240e;                        // ␎
+    si=  #$240f;                        // ␏
+    dle= #$2410;                        // ␐
+    dc1= #$2411;                        // ␑
+    dc2= #$2412;                        // ␒
+    dc3= #$2413;                        // ␓
+    dc4= #$2414;                        // ␔
+    nak= #$2415;                        // ␕
+    syn= #$2416;                        // ␖
+    etb= #$2417;                        // ␗
+    can= #$2418;                        // ␘
+    em=  #$2419;                        // ␙
+    sub= #$241a;                        // ␚
+    esc= #$241b;                        // ␛
+    fs=  #$241c;                        // ␜
+    gs=  #$241d;                        // ␝
+    rs=  #$241e;                        // ␞
+    us=  #$241f;                        // ␟
+    del= #$2420;                        // ␡
+    bar= #$033c;                        // ̼'
+
+  var
+    i, test, masked: integer;
+
+  begin
+    result := str;
+
+  (* This should probably be recoded to use a persistent table, but doing it    *)
+  (* this way results in no lookup for plain text which is likely to be the     *)
+  (* bulk of the output. I'm not making any assumptions about the Unicode       *)
+  (* characters being sequential so that this code can be used both for control *)
+  (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
+  (* want to adjust them he can do so.                                          *)
+
+    for i := Length(result) downto 1 do begin
+      test := Ord(result[i]);
+      if c1Underbar then
+        masked := test and $7f          (* Handle both C0 and C1 in one operation *)
+      else
+        masked := test;
+      case masked of
+        $00: result[i] := nul;
+        $01: result[i] := soh;
+        $02: result[i] := stx;
+        $03: result[i] := etx;
+        $04: result[i] := eot;
+        $05: result[i] := enq;
+        $06: result[i] := ack;
+        $07: result[i] := bel;
+        $08: result[i] := bs;
+        $09: result[i] := ht;
+        $0a: result[i] := lf;
+        $0b: result[i] := vt;
+        $0c: result[i] := ff;
+        $0d: result[i] := cr;
+        $0e: result[i] := so;
+        $0f: result[i] := si;
+        $10: result[i] := dle;
+        $11: result[i] := dc1;
+        $12: result[i] := dc2;
+        $13: result[i] := dc3;
+        $14: result[i] := dc4;
+        $15: result[i] := nak;
+        $16: result[i] := syn;
+        $17: result[i] := etb;
+        $18: result[i] := can;
+        $19: result[i] := em;
+        $1a: result[i] := sub;
+        $1b: result[i] := esc;
+        $1c: result[i] := fs;
+        $1d: result[i] := gs;
+        $1e: result[i] := rs;
+        $1f: result[i] := us;
+        $7f: result[i] := del
+      otherwise
+      end;
+      if c1Underbar and                 (* Now fix changed C1 characters        *)
+                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
+                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
+        Insert(bar, result, i + 1)
+    end
+  end { withControlPictures } ;
+
+
+  (* Translate C0 control codes to "pretty pictures", and optionally C1 codes
+    to the same glyph but with an underbar.
+  *)
+  function withIso2047(const str: widestring; c1Underbar: boolean): widestring;
+
+  (* I've not got access to a pukka copy of ISO-2047, so like (it appears)      *)
+  (* almost everybody else I'm assuming that the Wikipedia page is correct.     *)
+  (* this differs from the ECMA standard (only) in the backspace glyph, some    *)
+  (* terminals in particular the Burroughs TD730/830 range manufactured in the  *)
+  (* 1970s and 1980s depart slightly more. I've found limited open source       *)
+  (* projects that refer to this encoding, and those I've found have attempted  *)
+  (* to "correct" details like the "direction of rotation" of the glyphs for    *)
+  (* the DC1 through DC4 codes.                                                 *)
+  (*                                                                            *)
+  (* Suffixes W, E and B below refer to the variants found in the Wikipedia     *)
+  (* article, the ECMA standard and the Burroughs terminal documentation.       *)
+
+  const
+    nul=  #$2395;                       // ⎕
+    soh=  #$2308;                       // ⌈
+    stx=  #$22A5;                       // ⊥
+    etx=  #$230B;                       // ⌋
+    eot=  #$2301;                       // ⌁
+    enq=  #$22A0;                       // ⊠
+    ack=  #$2713;                       // ✓
+    bel=  #$237E;                       // ⍾
+    bsW=  #$232B;                       // ⌫
+    bsB=  #$2196;                       // ↖ The ECMA glyph is slightly curved
+    bs=   bsB;                          //   and has no Unicode representation.
+    ht=   #$2AAB;                       // ⪫
+    lf=   #$2261;                       // ≡
+    vt=   #$2A5B;                       // ⩛
+    ff=   #$21A1;                       // ↡
+    crW=  #$2aaa;                       // ⪪ ECMA the same
+    crB=  #$25bf;                       // ▿
+    cr=   crW;
+    so=   #$2297;                       // ⊗
+    si=   #$2299;                       // ⊙
+    dle=  #$229F;                       // ⊟
+    dc1=  #$25F7;                       // ◷ Nota bene: these rotate deosil
+    dc2=  #$25F6;                       // ◶
+    dc3=  #$25F5;                       // ◵
+    dc4=  #$25F4;                       // ◴
+    nak=  #$237B;                       // ⍻
+    syn=  #$238D;                       // ⎍
+    etb=  #$22A3;                       // ⊣
+    can=  #$29D6;                       // ⧖
+    em=   #$237F;                       // ⍿
+    sub=  #$2426;                       // ␦
+    esc=  #$2296;                       // ⊖
+    fs=   #$25F0;                       // ◰ Nota bene: these rotate widdershins
+    gsW=  #$25F1;                       // ◱ ECMA the same
+    gsB=  #$25b5;                       // ▵
+    gs=   gsW;
+    rsW=  #$25F2;                       // ◲ ECMA the same
+    rsB=  #$25c3;                       // ◃
+    rs=   rsW;
+    usW=  #$25F3;                       // ◳ ECMA the same
+    usB=  #$25b9;                       // ▹
+    us=   usW;
+    del=  #$2425;                       // ␥
+    bar=  #$033c;                       // ̼'
+
+(* Not represented above is a Burroughs glyph for ETX, which in the material    *)
+(* available to me appears indistinguisable from CAN. If anybody has variant    *)
+(* glyphs from other manufacturers please contribute.                           *)
+
+  var
+    i, test, masked: integer;
+
+  begin
+    result := str;
+
+  (* This should probably be recoded to use a persistent table, but doing it    *)
+  (* this way results in no lookup for plain text which is likely to be the     *)
+  (* bulk of the output. I'm not making any assumptions about the Unicode       *)
+  (* characters being sequential so that this code can be used both for control *)
+  (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
+  (* want to adjust them she can do so.                                         *)
+
+    for i := Length(result) downto 1 do begin
+      test := Ord(result[i]);
+      if c1Underbar then
+        masked := test and $7f          (* Handle both C0 and C1 in one operation *)
+      else
+        masked := test;
+      case masked of
+        $00: result[i] := nul;
+        $01: result[i] := soh;
+        $02: result[i] := stx;
+        $03: result[i] := etx;
+        $04: result[i] := eot;
+        $05: result[i] := enq;
+        $06: result[i] := ack;
+        $07: result[i] := bel;
+        $08: result[i] := bs;
+        $09: result[i] := ht;
+        $0a: result[i] := lf;
+        $0b: result[i] := vt;
+        $0c: result[i] := ff;
+        $0d: result[i] := cr;
+        $0e: result[i] := so;
+        $0f: result[i] := si;
+        $10: result[i] := dle;
+        $11: result[i] := dc1;
+        $12: result[i] := dc2;
+        $13: result[i] := dc3;
+        $14: result[i] := dc4;
+        $15: result[i] := nak;
+        $16: result[i] := syn;
+        $17: result[i] := etb;
+        $18: result[i] := can;
+        $19: result[i] := em;
+        $1a: result[i] := sub;
+        $1b: result[i] := esc;
+        $1c: result[i] := fs;
+        $1d: result[i] := gs;
+        $1e: result[i] := rs;
+        $1f: result[i] := us;
+        $7f: result[i] := del
+      otherwise
+      end;
+      if c1Underbar and                 (* Now fix changed C1 characters        *)
+                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
+                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
+        Insert(bar, result, i + 1)
+    end
+  end { withIso2047 } ;
+
+
+  (* Look at the line index cl in a TStringList. Assume that at the start there
+    will be a line number and padding occupying nl characters, after that will
+    be text. Convert the text to hex possibly inserting extra lines after the
+    one being processed, only the first (i.e. original) line has a line number.
+  *)
+  procedure expandAsHex(var stringList: TStringList; currentLine, lineNumberLength: integer);
+
+  var
+    lineNumberAsText,     scratch     : string;
+    dataAsByteArray: TBytes;
+    lengthLastBlock, startLastBlock: integer;
+
+
+    (* Recursively process the byte array from the end to the beginning. All
+      lines are inserted immediately after the original current line, except for
+      the final line processed which overwrites the original.
+    *)
+    procedure hexLines(start, bytes: integer);
+
+
+      (* The parameter is a line number as text or an equivalent run of spaces.
+        The result is a line of hex + ASCII data.
+      *)
+      function oneHexLine(const lineNum: string): widestring;
+
+      var
+        i: integer;
+
+      begin
+        result := lineNum;
+        for i := 0 to 15 do
+          if i < bytes then
+            result += LowerCase(HexStr(dataAsByteArray[start + i], 2)) + ' '
+          else
+            result += '   ';
+        result += ' ';                  (* Between hex and ASCII                *)
+        for i := 0 to 15 do
+          if i < bytes then
+            case dataAsByteArray[start + i] of
+              $20..$7e: result += Chr(dataAsByteArray[start + i])
+            otherwise
+              result += #$00B7          // ·
+            end
+      end { oneHexLine } ;
+
+
+    begin
+      if start = 0 then
+        stringList[currentLine] := oneHexLine(lineNumberAsText)
+      else begin
+        stringList.insert(currentLine + 1, oneHexLine(PadLeft('', Length(lineNumberAsText))));
+        hexLines(start - 16, 16)
+      end
+    end { hexLines } ;
+
+
+  begin
+    if lineNumberLength = 0 then begin
+      lineNumberAsText := '';
+      dataAsByteArray := BytesOf(Copy(stringList[currentLine], 1,
+                                Length(stringList[currentLine])))
+    end else begin                      (* Remember one extra space after number *)
+      lineNumberAsText := Copy(stringList[currentLine], 1, lineNumberLength + 1);
+      dataAsByteArray := BytesOf(Copy(stringList[currentLine], lineNumberLength + 2,
+                                Length(stringList[currentLine]) - (lineNumberLength + 1)))
+    end;
+    lengthLastBlock := Length(dataAsByteArray) mod 16;
+    startLastBlock := Length(dataAsByteArray) - lengthLastBlock;
+    hexLines(startLastBlock, lengthLastBlock)
+  end { expandAsHex } ;
+
+
 begin
   if ttyHandle = handleUnopened then begin (* Do this at first output only      *)
     //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.AddOutput Calling consoleSizeChanged']);
     consoleSizeChanged
   end;
-  while Memo1.Lines.Count > 5000 do
+
+(* Get the maximum number of lines to be displayed from the user interface,     *)
+(* work out how much space is needed to display a line number, and if necessary *)
+(* trim the amount of currently-stored text.                                    *)
+
+  try
+    lineLimit := StrToInt(Trim(MaskEdit1.Text))
+  except
+    MaskEdit1.Text := '5000';
+    lineLimit := 5000
+  end;
+  if CheckGroupRight.Checked[0] then    (* Line numbers?                        *)
+    case lineLimit + fFirstLine - 1 of
+      0..999:          numLength := 3;
+      1000..99999:     numLength := 5;
+      100000..9999999: numLength := 7
+    otherwise
+      numLength := 9
+    end
+  else
+    numLength := 0;
+  while Memo1.Lines.Count > lineLimit do
     Memo1.Lines.Delete(0);
 
-// Working note: make any adjustment to the number of lines etc. before we
-// start to add text which might include escape handling.
+(* Use an intermediate buffer to process the line or potentially lines of text  *)
+(* passed as the parameter; where formatting as hex breaks it up into multiple  *)
+(* lines, the line number is blanked on the synthetic ones. When lines or lists *)
+(* of lines are processed in reverse it is because an indeterminate number of   *)
+(* insertions (e.g. Unicode combining diacritics or extended hex output) may be *)
+(* inserted after the current index.                                            *)
+(*                                                                              *)
+(* This might look like a bit of a palaver, but a standard memo might exhibit   *)
+(* "interesting" behavior once the amount of text causes it to start scrolling  *)
+(* so having an intermediate that can be inspected might be useful.             *)
 
-  Memo1.Text:=Memo1.Text+AText;
-  Memo1.SelStart := length(Memo1.Text);
-end;
+  buffer := TStringList.Create;
+  try
+    buffer.Text := AText;     (* Decides what line breaks it wants to swallow   *)
+    if buffer.Count = 1 then
+      i := 12345              (* Good place for a breakpoint                    *)
+    else
+      i := 67890;             (* Another good place for a breakpoint            *)
+    case RadioGroupRight.ItemIndex of
+      1: for i := 0 to buffer.Count - 1 do
+           buffer[i] := withControlPictures(buffer[i], CheckGroupRight.Checked[1]);
+      2: for i := 0 to buffer.Count - 1 do
+           buffer[i] := withIso2047(buffer[i], CheckGroupRight.Checked[1])
+    otherwise
+    end;
+    for i := 0 to buffer.Count - 1 do begin             (* Line numbers         *)
+      if numLength > 0 then
+        buffer[i] := PadLeft(IntToStr(fFirstLine), numLength) + ' ' + buffer[i];
+      fFirstLine += 1
+    end;
+    if RadioGroupRight.ItemIndex = 3 then (* Expand hex line-by-line in reverse *)
+      for i := buffer.Count - 1 downto 0 do
+        expandAsHex(buffer, i, numLength);
 
+(* Add the buffered text to the visible control(s), and clean up.               *)
+
+    Memo1.Lines.AddStrings(buffer)
+  finally
+    buffer.Free
+  end;
+  Memo1.SelStart := length(Memo1.Text)
+end { TPseudoConsoleDlg.AddOutput } ;
+
+
 procedure TPseudoConsoleDlg.Clear;
+
 begin
   //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.Clear Calling FormResize']);
   FormResize(nil);                      (* Safe during IDE initialisation       *)
   Memo1.Text := '';
-end;
+  fFirstLine := 1
+end { TPseudoConsoleDlg.Clear } ;
 
+
 {$R *.lfm}
 
 initialization
Index: debugger/test/testconsolescroll.lpi
===================================================================
--- debugger/test/testconsolescroll.lpi	(nonexistent)
+++ debugger/test/testconsolescroll.lpi	(working copy)
@@ -0,0 +1,53 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="My Application"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="testconsolescroll.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TestConsoleScroll"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testconsolescroll"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
Index: debugger/test/testconsolescroll.pas
===================================================================
--- debugger/test/testconsolescroll.pas	(nonexistent)
+++ debugger/test/testconsolescroll.pas	(working copy)
@@ -0,0 +1,27 @@
+program TestConsoleScroll;
+
+(* This console-mode program for Linux or other unix implementations outputs	*)
+(* 100 numbered lines, followed by all 256 8-bit characters as a block. The	*)
+(* lines should be presented without intervening blanks, the character block	*)
+(* should make sense provided that a formatted console style is selected.	*)
+(*										*)
+(* It DOES NOT attempt any formatted output using escape sequences etc. MarkMLl	*)
+
+uses
+  SysUtils;
+
+var
+  i, j: integer;
+
+begin
+  for i := 1 to 100 do
+    WriteLn(i);
+  WriteLn;
+  for i := 0 to 15 do begin
+    for j := 1 to 15 do
+      Write(Chr(16 * i + j));
+    WriteLn
+  end;
+  WriteLn 
+end.
+  
Index: debugger/test/watchconsolesize.pas
===================================================================
--- debugger/test/watchconsolesize.pas	(revision 58484)
+++ debugger/test/watchconsolesize.pas	(working copy)
@@ -53,6 +53,8 @@
 
 
 begin
+  WriteLn('This header line comprises 50 characters plus EOL.');
+  WriteLn;
   WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
   reportSize;
   if not hookWinch() then
Index: ide/lazarus.lpi
===================================================================
--- ide/lazarus.lpi	(revision 58484)
+++ ide/lazarus.lpi	(working copy)
@@ -1429,10 +1429,10 @@
       <OtherUnitFiles Value="frames;../converter;../debugger;../debugger/frames;../packager;../designer;../packager/frames;../ide"/>
       <UnitOutputDirectory Value="$(LazarusDir)/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
     </SearchPaths>
-    <CompileReasons Compile="False" Build="False" Run="False"/>
+    <CompileReasons Run="False"/>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="2">
+    <Exceptions Count="3">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -1439,6 +1439,9 @@
       <Item2>
         <Name Value="ECodetoolError"/>
       </Item2>
+      <Item3>
+        <Name Value="EReadError"/>
+      </Item3>
     </Exceptions>
   </Debugging>
 </CONFIG>
Index: ide/lazarus.res
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream

Mark Morgan Lloyd

2018-07-13 13:18

reporter   ~0109424

I've uploaded a first cut which adds a bit of extra stuff to unformatted output, and puts this onto a tabbed page with a hidden one for subsequent work.

There's a handful of compilation warnings due to ASCII/UTF-8 conversions to be worked out, and the whole thing could do with refactoring before adding formatted (ANSI or whatever) output.

An additional test program appears to demonstrate that the doublespacing is an effect of memo resizing, so far I've not tracked it down. I'm still having problems getting at the terminal type from the environment. I can't get the maskededit to store 0000032 as blank.

Martin Friebe

2018-07-13 15:13

manager  

debug-console-unformatted-new.patch (15,550 bytes)
Index: debugger/pseudoterminaldlg.lfm
===================================================================
--- debugger/pseudoterminaldlg.lfm	(revision 58501)
+++ debugger/pseudoterminaldlg.lfm	(working copy)
@@ -1,24 +1,210 @@
 object PseudoConsoleDlg: TPseudoConsoleDlg
-  Left = 697
-  Height = 240
-  Top = 327
-  Width = 320
+  Left = 438
+  Height = 480
+  Top = 321
+  Width = 800
   Caption = 'Console'
-  ClientHeight = 240
-  ClientWidth = 320
+  ClientHeight = 480
+  ClientWidth = 800
   DockSite = True
   OnResize = FormResize
   LCLVersion = '1.9.0.0'
-  object Memo1: TMemo
+  object PageControl1: TPageControl
     Left = 0
-    Height = 240
+    Height = 460
     Top = 0
-    Width = 320
+    Width = 800
+    ActivePage = TabSheetRaw
     Align = alClient
-    OnUTF8KeyPress = Memo1UTF8KeyPress
-    ReadOnly = True
-    ScrollBars = ssAutoBoth
+    TabIndex = 1
     TabOrder = 0
-    WantTabs = True
+    object TabSheet1: TTabSheet
+      Caption = 'Formatted'
+      ClientHeight = 430
+      ClientWidth = 790
+      TabVisible = False
+      object Panel1: TPanel
+        Left = 470
+        Height = 430
+        Top = 0
+        Width = 160
+        Align = alRight
+        Caption = 'Panel1'
+        TabOrder = 0
+      end
+    end
+    object TabSheetRaw: TTabSheet
+      Caption = 'Raw Output'
+      ClientHeight = 430
+      ClientWidth = 790
+      object PairSplitterRaw: TPairSplitter
+        Left = 0
+        Height = 430
+        Top = 0
+        Width = 790
+        Align = alClient
+        Position = 600
+        object PairSplitterRawLeft: TPairSplitterSide
+          Cursor = crArrow
+          Left = 0
+          Height = 430
+          Top = 0
+          Width = 600
+          ClientWidth = 600
+          ClientHeight = 430
+          object Memo1: TMemo
+            Left = 4
+            Height = 422
+            Top = 4
+            Width = 592
+            Align = alClient
+            BorderSpacing.Around = 4
+            Font.Name = 'Monospace'
+            OnUTF8KeyPress = Memo1UTF8KeyPress
+            ParentFont = False
+            ReadOnly = True
+            ScrollBars = ssAutoBoth
+            TabOrder = 0
+            WantTabs = True
+          end
+        end
+        object PairSplitterRawRight: TPairSplitterSide
+          Cursor = crArrow
+          Left = 605
+          Height = 430
+          Top = 0
+          Width = 185
+          ClientWidth = 185
+          ClientHeight = 430
+          OnResize = PairSplitterRawRightResize
+          object RadioGroupRight: TRadioGroup
+            Left = 0
+            Height = 103
+            Top = 0
+            Width = 185
+            Align = alTop
+            AutoFill = True
+            AutoSize = True
+            Caption = 'Output Style'
+            ChildSizing.LeftRightSpacing = 6
+            ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+            ChildSizing.EnlargeVertical = crsHomogenousChildResize
+            ChildSizing.ShrinkHorizontal = crsScaleChilds
+            ChildSizing.ShrinkVertical = crsScaleChilds
+            ChildSizing.Layout = cclLeftToRightThenTopToBottom
+            ChildSizing.ControlsPerLine = 1
+            ClientHeight = 84
+            ClientWidth = 183
+            ItemIndex = 0
+            Items.Strings = (
+              'Unformatted'
+              'C0 as Control Pictures'
+              'C0 as ISO 2047'
+              'Hex + ASCII'
+            )
+            OnSelectionChanged = RadioGroupRightSelectionChanged
+            TabOrder = 1
+          end
+          object PanelRightBelowRG: TPanel
+            Left = 0
+            Height = 327
+            Top = 103
+            Width = 185
+            Align = alClient
+            BevelOuter = bvNone
+            ClientHeight = 327
+            ClientWidth = 185
+            TabOrder = 0
+            object CheckGroupRight: TCheckGroup
+              Left = 0
+              Height = 73
+              Top = 0
+              Width = 185
+              Align = alTop
+              AutoFill = True
+              AutoSize = True
+              Caption = 'Decorations'
+              ChildSizing.LeftRightSpacing = 6
+              ChildSizing.TopBottomSpacing = 6
+              ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+              ChildSizing.EnlargeVertical = crsHomogenousChildResize
+              ChildSizing.ShrinkHorizontal = crsScaleChilds
+              ChildSizing.ShrinkVertical = crsScaleChilds
+              ChildSizing.Layout = cclLeftToRightThenTopToBottom
+              ChildSizing.ControlsPerLine = 1
+              ClientHeight = 54
+              ClientWidth = 183
+              Enabled = False
+              Items.Strings = (
+                'Line numbers'
+                'C1 as C0 + Underbar'
+              )
+              TabOrder = 1
+              Data = {
+                020000000202
+              }
+            end
+            object PanelRightBelowCG: TPanel
+              Left = 0
+              Height = 254
+              Top = 73
+              Width = 185
+              Align = alClient
+              BevelOuter = bvNone
+              ClientHeight = 254
+              ClientWidth = 185
+              TabOrder = 0
+              object GroupBoxRight: TGroupBox
+                Left = 0
+                Height = 64
+                Top = 0
+                Width = 185
+                Align = alTop
+                Caption = 'Line limit'
+                ClientHeight = 45
+                ClientWidth = 183
+                TabOrder = 0
+                object MaskEdit1: TMaskEdit
+                  Left = 9
+                  Height = 30
+                  Top = 0
+                  Width = 128
+                  CharCase = ecNormal
+                  MaxLength = 7
+                  TabOrder = 0
+                  EditMask = '#######'
+                  Text = '5000   '
+                  SpaceChar = '_'
+                end
+              end
+            end
+          end
+        end
+      end
+    end
   end
+  object StatusBar1: TStatusBar
+    Left = 0
+    Height = 20
+    Top = 460
+    Width = 800
+    Panels = <    
+      item
+        Text = '    dumb'
+        Width = 160
+      end    
+      item
+        Text = '00 x 00 chars'
+        Width = 160
+      end    
+      item
+        Text = '000 x 000 pixels'
+        Width = 160
+      end    
+      item
+        Text = 'Not resized'
+        Width = 160
+      end>
+    SimplePanel = False
+  end
 end
Index: debugger/pseudoterminaldlg.pp
===================================================================
--- debugger/pseudoterminaldlg.pp	(revision 58501)
+++ debugger/pseudoterminaldlg.pp	(working copy)
@@ -35,8 +35,9 @@
 interface
 
 uses
-  IDEWindowIntf, Classes, Graphics,
-  Forms, StdCtrls, DebuggerDlg, BaseDebugManager, LazarusIDEStrConsts, LCLType;
+  IDEWindowIntf, Classes, Graphics, Forms, StdCtrls, DebuggerDlg,
+  BaseDebugManager, LazarusIDEStrConsts, LCLType, ComCtrls, ExtCtrls, MaskEdit,
+  PairSplitter;
 
 type
 
@@ -43,9 +44,25 @@
   { TPseudoConsoleDlg }
 
   TPseudoConsoleDlg = class(TDebuggerDlg)
+    CheckGroupRight: TCheckGroup;
+    GroupBoxRight: TGroupBox;
+    MaskEdit1: TMaskEdit;
     Memo1: TMemo;
+    PageControl1: TPageControl;
+    PairSplitterRaw: TPairSplitter;
+    PairSplitterRawLeft: TPairSplitterSide;
+    PairSplitterRawRight: TPairSplitterSide;
+    Panel1: TPanel;
+    PanelRightBelowRG: TPanel;
+    PanelRightBelowCG: TPanel;
+    RadioGroupRight: TRadioGroup;
+    StatusBar1: TStatusBar;
+    TabSheet1: TTabSheet;
+    TabSheetRaw: TTabSheet;
     procedure FormResize(Sender: TObject);
     procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
+    procedure PairSplitterRawRightResize(Sender: TObject);
+    procedure RadioGroupRightSelectionChanged(Sender: TObject);
   private
     { private declarations }
     ttyHandle: System.THandle;         (* Used only by unix for console size tracking  *)
@@ -53,6 +70,7 @@
     fCharWidth: word;
     fRowsPerScreen: integer;
     fColsPerRow: integer;
+    fFirstLine: integer;
     procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
     procedure consoleSizeChanged;
   protected
@@ -75,7 +93,7 @@
 implementation
 
 uses
-  SysUtils, LazLoggerBase
+  SysUtils, StrUtils, LazLoggerBase
 {$IFDEF DBG_ENABLE_TERMINAL}
   , Unix, BaseUnix, termio
 {$ENDIF DBG_ENABLE_TERMINAL}
@@ -98,6 +116,50 @@
 end;
 
 
+procedure TPseudoConsoleDlg.PairSplitterRawRightResize(Sender: TObject);
+
+var
+  ttyNotYetInitialised: boolean;
+
+begin
+
+(* These are not errors so much as conditions we will see while the IDE is      *)
+(* starting up.                                                                 *)
+
+  if DebugBoss = nil then
+    exit;
+  if DebugBoss.PseudoTerminal = nil then
+    exit;
+
+(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
+(* so while we prefer success we also consider that failure /is/ an acceptable  *)
+(* option in this case.                                                         *)
+
+  ttyNotYetInitialised := ttyHandle = handleUnopened;
+  //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.SplitterRawRightResize Calling consoleSizeChanged']);
+  consoleSizeChanged;
+  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
+    DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.SplitterRawRightResize Bad PseudoTerminal -> unopened']);
+    ttyHandle := handleUnopened
+  end;
+  StatusBar1.Panels[3].Text := 'Splitter resized'
+end { TPseudoConsoleDlg.PairSplitterRawRightResize } ;
+
+
+(* The C1 underbar decoration is only relevant when C0 is being displayed as
+  control pictures or ISO 2047 glyphs.
+*)
+procedure TPseudoConsoleDlg.RadioGroupRightSelectionChanged(Sender: TObject);
+
+begin
+  case RadioGroupRight.ItemIndex of
+    1, 2: CheckGroupRight.CheckEnabled[1] := true
+  otherwise
+    CheckGroupRight.CheckEnabled[1] := false
+  end
+end { TPseudoConsoleDlg.RadioGroupRightSelectionChanged } ;
+
+
 (* The form size has changed. Call a procedure to pass this to the kernel etc.,
   assuming that this works out the best control to track.
 *)
@@ -126,8 +188,9 @@
   if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
     DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
     ttyHandle := handleUnopened
-  end
-end;
+  end;
+  StatusBar1.Panels[3].Text := 'Window resized'
+end { TPseudoConsoleDlg.FormResize } ;
 
 
 procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
@@ -140,8 +203,9 @@
 {$ENDIF DBG_ENABLE_TERMINAL}
   inherited DoClose(CloseAction);
   CloseAction := caHide;
-end;
+end { TPseudoConsoleDlg.DoClose } ;
 
+
 constructor TPseudoConsoleDlg.Create(TheOwner: TComponent);
 begin
   inherited Create(TheOwner);
@@ -149,8 +213,9 @@
   Caption:= lisDbgTerminal;
   ttyHandle := handleUnopened;
   fRowsPerScreen := -1;
-  fColsPerRow := -1
-end;
+  fColsPerRow := -1;
+  fFirstLine := 1
+end { TPseudoConsoleDlg.Create } ;
 
 
 (* Get the height and width for characters described by the fount specified by
@@ -173,7 +238,7 @@
   finally
     bm.Free
   end
-end;
+end { TPseudoConsoleDlg.getCharHeightAndWidth } ;
 
 
 (* Assume that the console size has changed, either because it's just starting
@@ -275,8 +340,19 @@
 begin
   ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
 {$ENDIF DBG_ENABLE_TERMINAL }
-  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
-end;
+  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit');
+  RadioGroupRightSelectionChanged(nil); (* Sort out initial state               *)
+  StatusBar1.Panels[0].Width := Width div 4;
+  StatusBar1.Panels[0].Text := '    ' ; // + DebugBoss.Debugger.Environment.Values['TERM'];
+  StatusBar1.Panels[1].Width := Width div 4;
+{$IFDEF DBG_ENABLE_TERMINAL }
+  StatusBar1.Panels[1].Text := Format('%d cols x %d rows', [winsize.ws_col, winsize.ws_row]);
+{$ENDIF DBG_ENABLE_TERMINAL }
+  StatusBar1.Panels[2].Width := Width div 4;
+{$IFDEF DBG_ENABLE_TERMINAL }
+  StatusBar1.Panels[2].Text := Format('%d x %d pixels', [winsize.ws_xpixel, winsize.ws_ypixel])
+{$ENDIF DBG_ENABLE_TERMINAL }
+end { TPseudoConsoleDlg.consoleSizeChanged } ;
 
 
 procedure TPseudoConsoleDlg.AddOutput(const AText: String);
Index: debugger/test/testconsolescroll.lpi
===================================================================
--- debugger/test/testconsolescroll.lpi	(nonexistent)
+++ debugger/test/testconsolescroll.lpi	(working copy)
@@ -0,0 +1,53 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="My Application"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="testconsolescroll.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TestConsoleScroll"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testconsolescroll"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
Index: debugger/test/testconsolescroll.pas
===================================================================
--- debugger/test/testconsolescroll.pas	(nonexistent)
+++ debugger/test/testconsolescroll.pas	(working copy)
@@ -0,0 +1,27 @@
+program TestConsoleScroll;
+
+(* This console-mode program for Linux or other unix implementations outputs	*)
+(* 100 numbered lines, followed by all 256 8-bit characters as a block. The	*)
+(* lines should be presented without intervening blanks, the character block	*)
+(* should make sense provided that a formatted console style is selected.	*)
+(*										*)
+(* It DOES NOT attempt any formatted output using escape sequences etc. MarkMLl	*)
+
+uses
+  SysUtils;
+
+var
+  i, j: integer;
+
+begin
+  for i := 1 to 100 do
+    WriteLn(i);
+  WriteLn;
+  for i := 0 to 15 do begin
+    for j := 1 to 15 do
+      Write(Chr(16 * i + j));
+    WriteLn
+  end;
+  WriteLn 
+end.
+  
Index: debugger/test/watchconsolesize.pas
===================================================================
--- debugger/test/watchconsolesize.pas	(revision 58501)
+++ debugger/test/watchconsolesize.pas	(working copy)
@@ -53,6 +53,8 @@
 
 
 begin
+  WriteLn('This header line comprises 50 characters plus EOL.');
+  WriteLn;
   WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
   reportSize;
   if not hookWinch() then

Martin Friebe

2018-07-13 15:19

manager   ~0109426

Last edited: 2018-07-13 15:35

View 7 revisions

I reuploaded your patch, as it was failing.
** INCLUDING: IfDEF to compile on windows/Mac

Is it intended, that the memo x-min-size is 74? (presumingly resizing will later take the formated output, and not the raw output?)

The radiobox could do with a min-x constraint.

running the "scroll" test, I get no output at all? (fedora 64 bit).
It seems that one of the chars including/between 128 and 143 clears the entire text. (prevents the memo from showing anything) // maybe invalid utf8 (have not tested higher code points)

Maybe consider:
  Memo1.Lines.BeginUpdate;
  Memo1.Lines.EndUpdate;


You may want to look at
  Project1.RunParameterOptions.AssignEnvironmentTo()
  Project1.RunParameterOptions.GetActiveMode.AssignEnvironmentTo();
See debugmanager.
Project1 is a globar var for the current project (uses Project;)
=> The problem: this can be changed, after the app was started....
So better add an "Environment[]" / "EnvironmentCount" property (both read only) to DebugBoss. (reading from FDebugger.Environment)
You can use Project1, before the debugger is started, but then change to DebugBoss

Martin Friebe

2018-07-13 15:46

manager   ~0109427

For line numbers, a synedit (with gutter) would be great.
If you make FormatLineNumber virtual, you can override it (see SourceSynEditor how to install your own gutter), and add the offset for no longer visible lines (>5000). You need to set a fixed width though, because autosize wont work with that.
(I can have a go at the synedit part, if you want to use that).

SynEdit also has
  TextBetweenPoints[
    point(length(SynEdit.lines[SynEdit.lines.count-1])+1, SynEdit.lines.count),
    point(length(SynEdit.lines[SynEdit.lines.count-1])+1, SynEdit.lines.count)
  ]
   := newTextWithLineBreaks;

Mark Morgan Lloyd

2018-07-13 16:37

reporter   ~0109429

Last edited: 2018-07-13 16:46

View 2 revisions

> I reuploaded your patch, as it was failing.
> ** INCLUDING: IfDEF to compile on windows/Mac

Sorry, mea culpa. I meant to check on Windows and then a courier arrived...

> Is it intended, that the memo x-min-size is 74? (presumingly resizing will later take the formated
> output, and not the raw output?)

Once there's a formatted control on the other page the size will be taken from that. Raw output can stay more or less as it is: I lobbed in the things I know are useful.

> The radiobox could do with a min-x constraint.

I'll check.

> running the "scroll" test, I get no output at all? (fedora 64 bit).
> It seems that one of the chars including/between 128 and 143 clears the entire text. (prevents the
> memo from showing anything) // maybe invalid utf8 (have not tested higher code points)

Was working properly on Debian "Stretch" + KDE/Qt. I agree it could be one of the higher codepoints, they weren't displaying well but I was definitely getting output (without doublespacing). Apart from scroll the thing I wanted to test there was C1 underbar, but with that combination of desktop etc. all of the high chars displayed as ?

The scroll test program did show that when there was no resize line numbering in the memo was contiguous. However a resize once the memo was filled running the first program resulted in a blank line which /was/ numbered, which suggests that something spurious is getting into AddOutput() (or possibly being injected as input).

> Maybe consider:
> Memo1.Lines.BeginUpdate;
> Memo1.Lines.EndUpdate;
>
>
> You may want to look at
> Project1.RunParameterOptions.AssignEnvironmentTo()
> Project1.RunParameterOptions.GetActiveMode.AssignEnvironmentTo();
> See debugmanager.
> Project1 is a globar var for the current project (uses Project;)
> => The problem: this can be changed, after the app was started....
> So better add an "Environment[]" / "EnvironmentCount" property (both read only) to DebugBoss.
> (reading from FDebugger.Environment)
> You can use Project1, before the debugger is started, but then change to DebugBoss

Noting your earlier comments, my plan was to check whether the terminal type was a supported one (i.e. ansi, since I see little point attempting to provide xterm for non-unix users) and only enable the formatted output page if compatible.

> For line numbers, a synedit (with gutter) would be great.

A Synedit would probably be the right choice for formatted output, and as I've said Tito's Terminal might have useful hints. However keeping line numbers in the main output flow gives me the advantage of being able to not display them for long lines rendered as hex, i.e. the first 16 bytes gets a line number and the remainder are treated as continuations ("C in column 1" :-)

> If you make FormatLineNumber virtual, you can override it (see SourceSynEditor how to install
> your own gutter), and add the offset for no longer visible lines (>5000). You need to set a
> fixed width though, because autosize wont work with that.
> (I can have a go at the synedit part, if you want to use that).

Let's try to get the existing stuff sorted first. I've just had a quiet couple of days which allowed me to bash it out comparatively easily, but I fear that's coming to an end.

I'll DL your revised patch later and check it, but work's building up again.

Mark Morgan Lloyd

2018-07-14 16:58

reporter   ~0109454

Last edited: 2018-07-14 17:04

View 2 revisions

>> running the "scroll" test, I get no output at all? (fedora 64 bit).
>> It seems that one of the chars including/between 128 and 143 clears the entire text. (prevents the
>> memo from showing anything) // maybe invalid utf8 (have not tested higher code points)
>
> Was working properly on Debian "Stretch" + KDE/Qt. I agree it could be one of the higher codepoints,
> they weren't displaying well but I was definitely getting output (without doublespacing). Apart from
> scroll the thing I wanted to test there was C1 underbar, but with that combination of desktop etc.
> all of the high chars displayed as ?

Going back to 1.8.4+3.04 (i.e. before any of my changes and the last for which I've got a Qt variant), it works if Lazarus is built for Qt but not for GTK2. All versions of Lazarus that I've tested for GTK2 result in

(lazarus:8544): Gtk-CRITICAL **: gtk_text_buffer_emit_insert: assertion 'g_utf8_validate (text, len, NULL)' failed

with minor variations of that initial number. I've not worked out how th get a backtrace etc. for that yet.

Martin Friebe

2018-07-14 19:14

manager   ~0109458

The memo appears to expect utf8 (as it should in lazarus). But your test send data that is invalid utf8. So yes the error is to be expected.

If an app is expected to print ansi, that needs (even before your work) translation.
If an app is expected to print utf8, then invalid sequences should probably be shown as escaped sequence.

Mark Morgan Lloyd

2018-07-14 19:42

reporter   ~0109459

Last edited: 2018-07-14 20:02

View 2 revisions

That's the main reason I put in hex etc. support :-)

All of the styles except unformatted display ? (or a dot in the case of hex), which under the circumstances seems reasonable.

Mark Morgan Lloyd

2018-07-15 18:29

reporter  

debug-console-unformatted-new2.patch (14,103 bytes)
Index: debugger/pseudoterminaldlg.lfm
===================================================================
--- debugger/pseudoterminaldlg.lfm	(revision 58530)
+++ debugger/pseudoterminaldlg.lfm	(working copy)
@@ -1,24 +1,212 @@
 object PseudoConsoleDlg: TPseudoConsoleDlg
-  Left = 697
-  Height = 240
-  Top = 327
-  Width = 320
+  Left = 438
+  Height = 480
+  Top = 321
+  Width = 800
   Caption = 'Console'
-  ClientHeight = 240
-  ClientWidth = 320
+  ClientHeight = 480
+  ClientWidth = 800
   DockSite = True
   OnResize = FormResize
   LCLVersion = '1.9.0.0'
-  object Memo1: TMemo
+  object PageControl1: TPageControl
     Left = 0
-    Height = 240
+    Height = 460
     Top = 0
-    Width = 320
+    Width = 800
+    ActivePage = TabSheetRaw
     Align = alClient
-    OnUTF8KeyPress = Memo1UTF8KeyPress
-    ReadOnly = True
-    ScrollBars = ssAutoBoth
+    TabIndex = 1
     TabOrder = 0
-    WantTabs = True
+    object TabSheet1: TTabSheet
+      Caption = 'Formatted'
+      ClientHeight = 430
+      ClientWidth = 790
+      TabVisible = False
+      object Panel1: TPanel
+        Left = 470
+        Height = 430
+        Top = 0
+        Width = 160
+        Align = alRight
+        Caption = 'Panel1'
+        TabOrder = 0
+      end
+    end
+    object TabSheetRaw: TTabSheet
+      Caption = 'Raw Output'
+      ClientHeight = 430
+      ClientWidth = 790
+      object PairSplitterRaw: TPairSplitter
+        Left = 0
+        Height = 430
+        Top = 0
+        Width = 790
+        Align = alClient
+        Position = 600
+        object PairSplitterRawLeft: TPairSplitterSide
+          Cursor = crArrow
+          Left = 0
+          Height = 430
+          Top = 0
+          Width = 600
+          ClientWidth = 600
+          ClientHeight = 430
+          Constraints.MinWidth = 200
+          object Memo1: TMemo
+            Left = 4
+            Height = 422
+            Top = 4
+            Width = 592
+            Align = alClient
+            BorderSpacing.Around = 4
+            Font.Name = 'Monospace'
+            OnUTF8KeyPress = Memo1UTF8KeyPress
+            ParentFont = False
+            ReadOnly = True
+            ScrollBars = ssAutoBoth
+            TabOrder = 0
+            WantTabs = True
+          end
+        end
+        object PairSplitterRawRight: TPairSplitterSide
+          Cursor = crArrow
+          Left = 605
+          Height = 430
+          Top = 0
+          Width = 200
+          ClientWidth = 200
+          ClientHeight = 430
+          Constraints.MinWidth = 200
+          OnResize = PairSplitterRawRightResize
+          object RadioGroupRight: TRadioGroup
+            Left = 0
+            Height = 103
+            Top = 0
+            Width = 200
+            Align = alTop
+            AutoFill = True
+            AutoSize = True
+            Caption = 'Output Style'
+            ChildSizing.LeftRightSpacing = 6
+            ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+            ChildSizing.EnlargeVertical = crsHomogenousChildResize
+            ChildSizing.ShrinkHorizontal = crsScaleChilds
+            ChildSizing.ShrinkVertical = crsScaleChilds
+            ChildSizing.Layout = cclLeftToRightThenTopToBottom
+            ChildSizing.ControlsPerLine = 1
+            ClientHeight = 84
+            ClientWidth = 198
+            ItemIndex = 0
+            Items.Strings = (
+              'Unformatted'
+              'C0 as Control Pictures'
+              'C0 as ISO 2047'
+              'Hex + ASCII'
+            )
+            OnSelectionChanged = RadioGroupRightSelectionChanged
+            TabOrder = 1
+          end
+          object PanelRightBelowRG: TPanel
+            Left = 0
+            Height = 327
+            Top = 103
+            Width = 200
+            Align = alClient
+            BevelOuter = bvNone
+            ClientHeight = 327
+            ClientWidth = 200
+            TabOrder = 0
+            object CheckGroupRight: TCheckGroup
+              Left = 0
+              Height = 73
+              Top = 0
+              Width = 200
+              Align = alTop
+              AutoFill = True
+              AutoSize = True
+              Caption = 'Decorations'
+              ChildSizing.LeftRightSpacing = 6
+              ChildSizing.TopBottomSpacing = 6
+              ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+              ChildSizing.EnlargeVertical = crsHomogenousChildResize
+              ChildSizing.ShrinkHorizontal = crsScaleChilds
+              ChildSizing.ShrinkVertical = crsScaleChilds
+              ChildSizing.Layout = cclLeftToRightThenTopToBottom
+              ChildSizing.ControlsPerLine = 1
+              ClientHeight = 54
+              ClientWidth = 198
+              Enabled = False
+              Items.Strings = (
+                'Line numbers'
+                'C1 as C0 + Underbar'
+              )
+              TabOrder = 1
+              Data = {
+                020000000202
+              }
+            end
+            object PanelRightBelowCG: TPanel
+              Left = 0
+              Height = 254
+              Top = 73
+              Width = 200
+              Align = alClient
+              BevelOuter = bvNone
+              ClientHeight = 254
+              ClientWidth = 200
+              TabOrder = 0
+              object GroupBoxRight: TGroupBox
+                Left = 0
+                Height = 64
+                Top = 0
+                Width = 200
+                Align = alTop
+                Caption = 'Line limit'
+                ClientHeight = 45
+                ClientWidth = 198
+                TabOrder = 0
+                object MaskEdit1: TMaskEdit
+                  Left = 9
+                  Height = 30
+                  Top = 0
+                  Width = 128
+                  CharCase = ecNormal
+                  MaxLength = 7
+                  TabOrder = 0
+                  EditMask = '#######'
+                  Text = '5000   '
+                  SpaceChar = '_'
+                end
+              end
+            end
+          end
+        end
+      end
+    end
   end
+  object StatusBar1: TStatusBar
+    Left = 0
+    Height = 20
+    Top = 460
+    Width = 800
+    Panels = <    
+      item
+        Text = '    dumb'
+        Width = 160
+      end    
+      item
+        Text = '00 x 00 chars'
+        Width = 160
+      end    
+      item
+        Text = '000 x 000 pixels'
+        Width = 160
+      end    
+      item
+        Text = 'Not resized'
+        Width = 160
+      end>
+    SimplePanel = False
+  end
 end
Index: debugger/pseudoterminaldlg.pp
===================================================================
--- debugger/pseudoterminaldlg.pp	(revision 58530)
+++ debugger/pseudoterminaldlg.pp	(working copy)
@@ -35,8 +35,9 @@
 interface
 
 uses
-  IDEWindowIntf, Classes, Graphics,
-  Forms, StdCtrls, DebuggerDlg, BaseDebugManager, LazarusIDEStrConsts, LCLType;
+  IDEWindowIntf, Classes, Graphics, Forms, StdCtrls, DebuggerDlg,
+  BaseDebugManager, LazarusIDEStrConsts, LCLType, ComCtrls, ExtCtrls, MaskEdit,
+  PairSplitter;
 
 type
 
@@ -43,9 +44,25 @@
   { TPseudoConsoleDlg }
 
   TPseudoConsoleDlg = class(TDebuggerDlg)
+    CheckGroupRight: TCheckGroup;
+    GroupBoxRight: TGroupBox;
+    MaskEdit1: TMaskEdit;
     Memo1: TMemo;
+    PageControl1: TPageControl;
+    PairSplitterRaw: TPairSplitter;
+    PairSplitterRawLeft: TPairSplitterSide;
+    PairSplitterRawRight: TPairSplitterSide;
+    Panel1: TPanel;
+    PanelRightBelowRG: TPanel;
+    PanelRightBelowCG: TPanel;
+    RadioGroupRight: TRadioGroup;
+    StatusBar1: TStatusBar;
+    TabSheet1: TTabSheet;
+    TabSheetRaw: TTabSheet;
     procedure FormResize(Sender: TObject);
     procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
+    procedure PairSplitterRawRightResize(Sender: TObject);
+    procedure RadioGroupRightSelectionChanged(Sender: TObject);
   private
     { private declarations }
     ttyHandle: System.THandle;         (* Used only by unix for console size tracking  *)
@@ -53,6 +70,7 @@
     fCharWidth: word;
     fRowsPerScreen: integer;
     fColsPerRow: integer;
+    fFirstLine: integer;
     procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
     procedure consoleSizeChanged;
   protected
@@ -75,7 +93,7 @@
 implementation
 
 uses
-  SysUtils, LazLoggerBase
+  SysUtils, StrUtils, LazLoggerBase
 {$IFDEF DBG_ENABLE_TERMINAL}
   , Unix, BaseUnix, termio
 {$ENDIF DBG_ENABLE_TERMINAL}
@@ -98,6 +116,50 @@
 end;
 
 
+procedure TPseudoConsoleDlg.PairSplitterRawRightResize(Sender: TObject);
+
+var
+  ttyNotYetInitialised: boolean;
+
+begin
+
+(* These are not errors so much as conditions we will see while the IDE is      *)
+(* starting up.                                                                 *)
+
+  if DebugBoss = nil then
+    exit;
+  if DebugBoss.PseudoTerminal = nil then
+    exit;
+
+(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
+(* so while we prefer success we also consider that failure /is/ an acceptable  *)
+(* option in this case.                                                         *)
+
+  ttyNotYetInitialised := ttyHandle = handleUnopened;
+  //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.SplitterRawRightResize Calling consoleSizeChanged']);
+  consoleSizeChanged;
+  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
+    DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.SplitterRawRightResize Bad PseudoTerminal -> unopened']);
+    ttyHandle := handleUnopened
+  end;
+  StatusBar1.Panels[3].Text := 'Splitter resized'
+end { TPseudoConsoleDlg.PairSplitterRawRightResize } ;
+
+
+(* The C1 underbar decoration is only relevant when C0 is being displayed as
+  control pictures or ISO 2047 glyphs.
+*)
+procedure TPseudoConsoleDlg.RadioGroupRightSelectionChanged(Sender: TObject);
+
+begin
+  case RadioGroupRight.ItemIndex of
+    1, 2: CheckGroupRight.CheckEnabled[1] := true
+  otherwise
+    CheckGroupRight.CheckEnabled[1] := false
+  end
+end { TPseudoConsoleDlg.RadioGroupRightSelectionChanged } ;
+
+
 (* The form size has changed. Call a procedure to pass this to the kernel etc.,
   assuming that this works out the best control to track.
 *)
@@ -126,8 +188,9 @@
   if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
     DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
     ttyHandle := handleUnopened
-  end
-end;
+  end;
+  StatusBar1.Panels[3].Text := 'Window resized'
+end { TPseudoConsoleDlg.FormResize } ;
 
 
 procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
@@ -140,8 +203,9 @@
 {$ENDIF DBG_ENABLE_TERMINAL}
   inherited DoClose(CloseAction);
   CloseAction := caHide;
-end;
+end { TPseudoConsoleDlg.DoClose } ;
 
+
 constructor TPseudoConsoleDlg.Create(TheOwner: TComponent);
 begin
   inherited Create(TheOwner);
@@ -149,8 +213,9 @@
   Caption:= lisDbgTerminal;
   ttyHandle := handleUnopened;
   fRowsPerScreen := -1;
-  fColsPerRow := -1
-end;
+  fColsPerRow := -1;
+  fFirstLine := 1
+end { TPseudoConsoleDlg.Create } ;
 
 
 (* Get the height and width for characters described by the fount specified by
@@ -173,7 +238,7 @@
   finally
     bm.Free
   end
-end;
+end { TPseudoConsoleDlg.getCharHeightAndWidth } ;
 
 
 (* Assume that the console size has changed, either because it's just starting
@@ -275,8 +340,19 @@
 begin
   ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
 {$ENDIF DBG_ENABLE_TERMINAL }
-  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
-end;
+  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit');
+  RadioGroupRightSelectionChanged(nil); (* Sort out initial state               *)
+  StatusBar1.Panels[0].Width := Width div 4;
+  StatusBar1.Panels[0].Text := '    ' ; // + DebugBoss.Debugger.Environment.Values['TERM'];
+  StatusBar1.Panels[1].Width := Width div 4;
+{$IFDEF DBG_ENABLE_TERMINAL }
+  StatusBar1.Panels[1].Text := Format('%d cols x %d rows', [winsize.ws_col, winsize.ws_row]);
+{$ENDIF DBG_ENABLE_TERMINAL }
+  StatusBar1.Panels[2].Width := Width div 4;
+{$IFDEF DBG_ENABLE_TERMINAL }
+  StatusBar1.Panels[2].Text := Format('%d x %d pixels', [winsize.ws_xpixel, winsize.ws_ypixel])
+{$ENDIF DBG_ENABLE_TERMINAL }
+end { TPseudoConsoleDlg.consoleSizeChanged } ;
 
 
 procedure TPseudoConsoleDlg.AddOutput(const AText: String);
@@ -286,21 +362,31 @@
     //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.AddOutput Calling consoleSizeChanged']);
     consoleSizeChanged
   end;
-  while Memo1.Lines.Count > 5000 do
-    Memo1.Lines.Delete(0);
+  Memo1.Lines.BeginUpdate;
+  try
+    while Memo1.Lines.Count > 5000 do
+      Memo1.Lines.Delete(0);
 
 // Working note: make any adjustment to the number of lines etc. before we
 // start to add text which might include escape handling.
 
-  Memo1.Text:=Memo1.Text+AText;
-  Memo1.SelStart := length(Memo1.Text);
+    Memo1.Text:=Memo1.Text+AText;
+    Memo1.SelStart := length(Memo1.Text)
+  finally
+    Memo1.Lines.BeginUpdate
+  end
 end;
 
 procedure TPseudoConsoleDlg.Clear;
 begin
   //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.Clear Calling FormResize']);
-  FormResize(nil);                      (* Safe during IDE initialisation       *)
-  Memo1.Text := '';
+  Memo1.Lines.BeginUpdate;
+  try
+    FormResize(nil);                    (* Safe during IDE initialisation       *)
+    Memo1.Text := '';
+  finally
+    Memo1.Lines.BeginUpdate
+  end
 end;
 
 {$R *.lfm}
Index: debugger/test/watchconsolesize.pas
===================================================================
--- debugger/test/watchconsolesize.pas	(revision 58530)
+++ debugger/test/watchconsolesize.pas	(working copy)
@@ -53,6 +53,8 @@
 
 
 begin
+  WriteLn('This header line comprises 50 characters plus EOL.');
+  WriteLn;
   WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
   reportSize;
   if not hookWinch() then

Mark Morgan Lloyd

2018-07-15 18:33

reporter   ~0109494

Fixed min width at splitter. Added begin/end update (but doesn't have any effect on scrolling problem).

Have *not* fixed sort order in contributors file, in case I mess up accented characters etc. :-)

Martin Friebe

2018-07-16 13:22

manager   ~0109518

Is the new patch complete? It seems to miss substantial parts of the previous patch?

If I try to apply the previous patch first (my versions, since yours has conflicts), then your new patch conflicts.

Could you make one patch, based on current svn, please?

---------
Btw, neither seem to fully work for me.

Behaviour of the splitter is a matter of opinion. IMHO (but not mandatory), if you resize the entire window, the splitter should move, so the radio-column keeps it width and the memo changes. Currently the radio-column just disappears if you make the window smaller.

Line numbers and output style: They seem to have no effect?

Possible that my version of your patch is not complete, if I missed some of the parts that failed when trying to apply your patch.

Mark Morgan Lloyd

2018-07-16 15:13

reporter   ~0109523

You didn't send the stuff that actually implemented line numbers etc. in your revised patch, so I assumed you wanted to sort out the UI aspect (min-width etc.) first :-)

OK, I'll try to sort something out later.

Martin Friebe

2018-07-16 15:26

manager   ~0109524

Sorry, when I revised the first patch, I wasnt aware that I missed something. I thought I had all the failing chunks done by hand

Mark Morgan Lloyd

2018-07-17 11:24

reporter  

debug-console-unformatted2.diff (30,977 bytes)
Index: debugger/pseudoterminaldlg.lfm
===================================================================
--- debugger/pseudoterminaldlg.lfm	(revision 58550)
+++ debugger/pseudoterminaldlg.lfm	(working copy)
@@ -1,24 +1,212 @@
 object PseudoConsoleDlg: TPseudoConsoleDlg
-  Left = 697
-  Height = 240
-  Top = 327
-  Width = 320
+  Left = 438
+  Height = 480
+  Top = 321
+  Width = 800
   Caption = 'Console'
-  ClientHeight = 240
-  ClientWidth = 320
+  ClientHeight = 480
+  ClientWidth = 800
   DockSite = True
   OnResize = FormResize
   LCLVersion = '1.9.0.0'
-  object Memo1: TMemo
+  object PageControl1: TPageControl
     Left = 0
-    Height = 240
+    Height = 460
     Top = 0
-    Width = 320
+    Width = 800
+    ActivePage = TabSheetRaw
     Align = alClient
-    OnUTF8KeyPress = Memo1UTF8KeyPress
-    ReadOnly = True
-    ScrollBars = ssAutoBoth
+    TabIndex = 1
     TabOrder = 0
-    WantTabs = True
+    object TabSheet1: TTabSheet
+      Caption = 'Formatted'
+      ClientHeight = 430
+      ClientWidth = 790
+      TabVisible = False
+      object Panel1: TPanel
+        Left = 470
+        Height = 430
+        Top = 0
+        Width = 160
+        Align = alRight
+        Caption = 'Panel1'
+        TabOrder = 0
+      end
+    end
+    object TabSheetRaw: TTabSheet
+      Caption = 'Raw Output'
+      ClientHeight = 430
+      ClientWidth = 790
+      object PairSplitterRaw: TPairSplitter
+        Left = 0
+        Height = 430
+        Top = 0
+        Width = 790
+        Align = alClient
+        Position = 600
+        object PairSplitterRawLeft: TPairSplitterSide
+          Cursor = crArrow
+          Left = 0
+          Height = 430
+          Top = 0
+          Width = 600
+          ClientWidth = 600
+          ClientHeight = 430
+          Constraints.MinWidth = 200
+          object Memo1: TMemo
+            Left = 4
+            Height = 422
+            Top = 4
+            Width = 592
+            Align = alClient
+            BorderSpacing.Around = 4
+            Font.Name = 'Monospace'
+            OnUTF8KeyPress = Memo1UTF8KeyPress
+            ParentFont = False
+            ReadOnly = True
+            ScrollBars = ssAutoBoth
+            TabOrder = 0
+            WantTabs = True
+          end
+        end
+        object PairSplitterRawRight: TPairSplitterSide
+          Cursor = crArrow
+          Left = 605
+          Height = 430
+          Top = 0
+          Width = 200
+          ClientWidth = 200
+          ClientHeight = 430
+          Constraints.MinWidth = 200
+          OnResize = PairSplitterRawRightResize
+          object RadioGroupRight: TRadioGroup
+            Left = 0
+            Height = 103
+            Top = 0
+            Width = 200
+            Align = alTop
+            AutoFill = True
+            AutoSize = True
+            Caption = 'Output Style'
+            ChildSizing.LeftRightSpacing = 6
+            ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+            ChildSizing.EnlargeVertical = crsHomogenousChildResize
+            ChildSizing.ShrinkHorizontal = crsScaleChilds
+            ChildSizing.ShrinkVertical = crsScaleChilds
+            ChildSizing.Layout = cclLeftToRightThenTopToBottom
+            ChildSizing.ControlsPerLine = 1
+            ClientHeight = 84
+            ClientWidth = 198
+            ItemIndex = 0
+            Items.Strings = (
+              'Unformatted'
+              'C0 as Control Pictures'
+              'C0 as ISO 2047'
+              'Hex + ASCII'
+            )
+            OnSelectionChanged = RadioGroupRightSelectionChanged
+            TabOrder = 1
+          end
+          object PanelRightBelowRG: TPanel
+            Left = 0
+            Height = 327
+            Top = 103
+            Width = 200
+            Align = alClient
+            BevelOuter = bvNone
+            ClientHeight = 327
+            ClientWidth = 200
+            TabOrder = 0
+            object CheckGroupRight: TCheckGroup
+              Left = 0
+              Height = 73
+              Top = 0
+              Width = 200
+              Align = alTop
+              AutoFill = True
+              AutoSize = True
+              Caption = 'Decorations'
+              ChildSizing.LeftRightSpacing = 6
+              ChildSizing.TopBottomSpacing = 6
+              ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+              ChildSizing.EnlargeVertical = crsHomogenousChildResize
+              ChildSizing.ShrinkHorizontal = crsScaleChilds
+              ChildSizing.ShrinkVertical = crsScaleChilds
+              ChildSizing.Layout = cclLeftToRightThenTopToBottom
+              ChildSizing.ControlsPerLine = 1
+              ClientHeight = 54
+              ClientWidth = 198
+              Enabled = False
+              Items.Strings = (
+                'Line numbers'
+                'C1 as C0 + Underbar'
+              )
+              TabOrder = 1
+              Data = {
+                020000000202
+              }
+            end
+            object PanelRightBelowCG: TPanel
+              Left = 0
+              Height = 254
+              Top = 73
+              Width = 200
+              Align = alClient
+              BevelOuter = bvNone
+              ClientHeight = 254
+              ClientWidth = 200
+              TabOrder = 0
+              object GroupBoxRight: TGroupBox
+                Left = 0
+                Height = 64
+                Top = 0
+                Width = 200
+                Align = alTop
+                Caption = 'Line limit'
+                ClientHeight = 45
+                ClientWidth = 198
+                TabOrder = 0
+                object MaskEdit1: TMaskEdit
+                  Left = 9
+                  Height = 30
+                  Top = 0
+                  Width = 128
+                  CharCase = ecNormal
+                  MaxLength = 7
+                  TabOrder = 0
+                  EditMask = '#######'
+                  Text = '5000   '
+                  SpaceChar = '_'
+                end
+              end
+            end
+          end
+        end
+      end
+    end
   end
+  object StatusBar1: TStatusBar
+    Left = 0
+    Height = 20
+    Top = 460
+    Width = 800
+    Panels = <    
+      item
+        Text = '    dumb'
+        Width = 160
+      end    
+      item
+        Text = '00 x 00 chars'
+        Width = 160
+      end    
+      item
+        Text = '000 x 000 pixels'
+        Width = 160
+      end    
+      item
+        Text = 'Not resized'
+        Width = 160
+      end>
+    SimplePanel = False
+  end
 end
Index: debugger/pseudoterminaldlg.pp
===================================================================
--- debugger/pseudoterminaldlg.pp	(revision 58550)
+++ debugger/pseudoterminaldlg.pp	(working copy)
@@ -30,13 +30,12 @@
 
 {$mode objfpc}{$H+}
 
-{$IFDEF linux} {$DEFINE DBG_ENABLE_TERMINAL} {$ENDIF}
-
 interface
 
 uses
-  IDEWindowIntf, Classes, Graphics,
-  Forms, StdCtrls, DebuggerDlg, BaseDebugManager, LazarusIDEStrConsts, LCLType;
+  IDEWindowIntf, Classes, Graphics, Forms, StdCtrls, DebuggerDlg,
+  BaseDebugManager, LazarusIDEStrConsts, LCLType, ComCtrls, ExtCtrls, MaskEdit,
+  PairSplitter;
 
 type
 
@@ -43,9 +42,25 @@
   { TPseudoConsoleDlg }
 
   TPseudoConsoleDlg = class(TDebuggerDlg)
+    CheckGroupRight: TCheckGroup;
+    GroupBoxRight: TGroupBox;
+    MaskEdit1: TMaskEdit;
     Memo1: TMemo;
+    PageControl1: TPageControl;
+    PairSplitterRaw: TPairSplitter;
+    PairSplitterRawLeft: TPairSplitterSide;
+    PairSplitterRawRight: TPairSplitterSide;
+    Panel1: TPanel;
+    PanelRightBelowRG: TPanel;
+    PanelRightBelowCG: TPanel;
+    RadioGroupRight: TRadioGroup;
+    StatusBar1: TStatusBar;
+    TabSheet1: TTabSheet;
+    TabSheetRaw: TTabSheet;
     procedure FormResize(Sender: TObject);
     procedure Memo1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
+    procedure PairSplitterRawRightResize(Sender: TObject);
+    procedure RadioGroupRightSelectionChanged(Sender: TObject);
   private
     { private declarations }
     ttyHandle: System.THandle;         (* Used only by unix for console size tracking  *)
@@ -53,6 +68,7 @@
     fCharWidth: word;
     fRowsPerScreen: integer;
     fColsPerRow: integer;
+    fFirstLine: integer;
     procedure getCharHeightAndWidth(consoleFont: TFont; out h, w: word);
     procedure consoleSizeChanged;
   protected
@@ -75,10 +91,10 @@
 implementation
 
 uses
-  SysUtils, LazLoggerBase
-{$IFDEF DBG_ENABLE_TERMINAL}
+  SysUtils, StrUtils, LazLoggerBase
+{$IFDEF UNIX}
   , Unix, BaseUnix, termio
-{$ENDIF DBG_ENABLE_TERMINAL}
+{$ENDIF UNIX}
   ;
 
 const
@@ -98,6 +114,50 @@
 end;
 
 
+procedure TPseudoConsoleDlg.PairSplitterRawRightResize(Sender: TObject);
+
+var
+  ttyNotYetInitialised: boolean;
+
+begin
+
+(* These are not errors so much as conditions we will see while the IDE is      *)
+(* starting up.                                                                 *)
+
+  if DebugBoss = nil then
+    exit;
+  if DebugBoss.PseudoTerminal = nil then
+    exit;
+
+(* Even if the IDE is initialised this can be called before the TTY is set up,  *)
+(* so while we prefer success we also consider that failure /is/ an acceptable  *)
+(* option in this case.                                                         *)
+
+  ttyNotYetInitialised := ttyHandle = handleUnopened;
+  //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.SplitterRawRightResize Calling consoleSizeChanged']);
+  consoleSizeChanged;
+  if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
+    DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.SplitterRawRightResize Bad PseudoTerminal -> unopened']);
+    ttyHandle := handleUnopened
+  end;
+  StatusBar1.Panels[3].Text := 'Splitter resized'
+end { TPseudoConsoleDlg.PairSplitterRawRightResize } ;
+
+
+(* The C1 underbar decoration is only relevant when C0 is being displayed as
+  control pictures or ISO 2047 glyphs.
+*)
+procedure TPseudoConsoleDlg.RadioGroupRightSelectionChanged(Sender: TObject);
+
+begin
+  case RadioGroupRight.ItemIndex of
+    1, 2: CheckGroupRight.CheckEnabled[1] := true
+  otherwise
+    CheckGroupRight.CheckEnabled[1] := false
+  end
+end { TPseudoConsoleDlg.RadioGroupRightSelectionChanged } ;
+
+
 (* The form size has changed. Call a procedure to pass this to the kernel etc.,
   assuming that this works out the best control to track.
 *)
@@ -126,23 +186,27 @@
   if ttyNotYetInitialised and (integer(ttyHandle) < 0) then begin
     DebugLn(DBG_WARNINGS, ['TPseudoConsoleDlg.FormResize Bad PseudoTerminal -> unopened']);
     ttyHandle := handleUnopened
-  end
-end;
+  end;
+  StatusBar1.Panels[3].Text := 'Window resized'
+end { TPseudoConsoleDlg.FormResize } ;
 
 
 procedure TPseudoConsoleDlg.DoClose(var CloseAction: TCloseAction);
+
 begin
-{$IFDEF DBG_ENABLE_TERMINAL}
+{$IFDEF UNIX}
   if integer(ttyHandle) >= 0 then begin
     FileClose(ttyHandle);
     ttyHandle := handleUnopened
   end;
-{$ENDIF DBG_ENABLE_TERMINAL}
+{$ENDIF UNIX}
   inherited DoClose(CloseAction);
   CloseAction := caHide;
-end;
+end { TPseudoConsoleDlg.DoClose } ;
 
+
 constructor TPseudoConsoleDlg.Create(TheOwner: TComponent);
+
 begin
   inherited Create(TheOwner);
   font.Name := 'monospace';
@@ -149,8 +213,9 @@
   Caption:= lisDbgTerminal;
   ttyHandle := handleUnopened;
   fRowsPerScreen := -1;
-  fColsPerRow := -1
-end;
+  fColsPerRow := -1;
+  fFirstLine := 1
+end { TPseudoConsoleDlg.Create } ;
 
 
 (* Get the height and width for characters described by the fount specified by
@@ -173,7 +238,7 @@
   finally
     bm.Free
   end
-end;
+end { TPseudoConsoleDlg.getCharHeightAndWidth } ;
 
 
 (* Assume that the console size has changed, either because it's just starting
@@ -184,7 +249,7 @@
 *)
 procedure TPseudoConsoleDlg.consoleSizeChanged;
 
-{$IFDEF DBG_ENABLE_TERMINAL }
+{$IFDEF UNIX }
 { DEFINE USE_SLAVE_HANDLE }
 { DEFINE SEND_EXPLICIT_SIGNAL }
 
@@ -274,35 +339,421 @@
 {$ELSE       }
 begin
   ttyHandle := THandle(-1);             (* Not used in non-unix OSes            *)
-{$ENDIF DBG_ENABLE_TERMINAL }
-  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit')
-end;
+{$ENDIF UNIX }
+  Assert(ttyHandle <> handleUnopened, 'TPseudoConsoleDlg.consoleSizeChanged: TTY handle still in virgin state at exit');
+  RadioGroupRightSelectionChanged(nil); (* Sort out initial state               *)
+  StatusBar1.Panels[0].Width := Width div 4;
+  StatusBar1.Panels[0].Text := '    ' ; // + DebugBoss.Debugger.Environment.Values['TERM'];
+  StatusBar1.Panels[1].Width := Width div 4;
+  StatusBar1.Panels[1].Text := Format('%d cols x %d rows', [winsize.ws_col, winsize.ws_row]);
+  StatusBar1.Panels[2].Width := Width div 4;
+  StatusBar1.Panels[2].Text := Format('%d x %d pixels', [winsize.ws_xpixel, winsize.ws_ypixel])
+end { TPseudoConsoleDlg.consoleSizeChanged } ;
 
 
 procedure TPseudoConsoleDlg.AddOutput(const AText: String);
 
+var
+  lineLimit, numLength, i: integer;
+  buffer: TStringList;
+
+
+  (* Translate C0 control codes to "control pictures", and optionally C1 codes
+    to the same glyph but with an underbar.
+  *)
+  function withControlPictures(const str: widestring; c1Underbar: boolean): widestring;
+
+  const
+    nul= #$2400;                        // ␀
+    soh= #$2401;                        // ␁
+    stx= #$2402;                        // ␂
+    etx= #$2403;                        // ␃
+    eot= #$2404;                        // ␄
+    enq= #$2405;                        // ␅
+    ack= #$2406;                        // ␆
+    bel= #$2407;                        // ␇
+    bs=  #$2408;                        // ␈
+    ht=  #$2409;                        // ␉
+    lf=  #$240a;                        // ␊
+    vt=  #$240b;                        // ␋
+    ff=  #$240c;                        // ␌
+    cr=  #$240d;                        // ␍
+    so=  #$240e;                        // ␎
+    si=  #$240f;                        // ␏
+    dle= #$2410;                        // ␐
+    dc1= #$2411;                        // ␑
+    dc2= #$2412;                        // ␒
+    dc3= #$2413;                        // ␓
+    dc4= #$2414;                        // ␔
+    nak= #$2415;                        // ␕
+    syn= #$2416;                        // ␖
+    etb= #$2417;                        // ␗
+    can= #$2418;                        // ␘
+    em=  #$2419;                        // ␙
+    sub= #$241a;                        // ␚
+    esc= #$241b;                        // ␛
+    fs=  #$241c;                        // ␜
+    gs=  #$241d;                        // ␝
+    rs=  #$241e;                        // ␞
+    us=  #$241f;                        // ␟
+    del= #$2420;                        // ␡
+    bar= #$033c;                        // ̼'
+
+  var
+    i, test, masked: integer;
+
+  begin
+    result := str;
+
+  (* This should probably be recoded to use a persistent table, but doing it    *)
+  (* this way results in no lookup for plain text which is likely to be the     *)
+  (* bulk of the output. I'm not making any assumptions about the Unicode       *)
+  (* characters being sequential so that this code can be used both for control *)
+  (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
+  (* want to adjust them he can do so.                                          *)
+
+    for i := Length(result) downto 1 do begin
+      test := Ord(result[i]);
+      if c1Underbar then
+        masked := test and $7f          (* Handle both C0 and C1 in one operation *)
+      else
+        masked := test;
+      case masked of
+        $00: result[i] := nul;
+        $01: result[i] := soh;
+        $02: result[i] := stx;
+        $03: result[i] := etx;
+        $04: result[i] := eot;
+        $05: result[i] := enq;
+        $06: result[i] := ack;
+        $07: result[i] := bel;
+        $08: result[i] := bs;
+        $09: result[i] := ht;
+        $0a: result[i] := lf;
+        $0b: result[i] := vt;
+        $0c: result[i] := ff;
+        $0d: result[i] := cr;
+        $0e: result[i] := so;
+        $0f: result[i] := si;
+        $10: result[i] := dle;
+        $11: result[i] := dc1;
+        $12: result[i] := dc2;
+        $13: result[i] := dc3;
+        $14: result[i] := dc4;
+        $15: result[i] := nak;
+        $16: result[i] := syn;
+        $17: result[i] := etb;
+        $18: result[i] := can;
+        $19: result[i] := em;
+        $1a: result[i] := sub;
+        $1b: result[i] := esc;
+        $1c: result[i] := fs;
+        $1d: result[i] := gs;
+        $1e: result[i] := rs;
+        $1f: result[i] := us;
+        $7f: result[i] := del
+      otherwise
+      end;
+      if c1Underbar and                 (* Now fix changed C1 characters        *)
+                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
+                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
+        Insert(bar, result, i + 1)
+    end
+  end { withControlPictures } ;
+
+
+  (* Translate C0 control codes to "pretty pictures", and optionally C1 codes
+    to the same glyph but with an underbar.
+  *)
+  function withIso2047(const str: widestring; c1Underbar: boolean): widestring;
+
+  (* I've not got access to a pukka copy of ISO-2047, so like (it appears)      *)
+  (* almost everybody else I'm assuming that the Wikipedia page is correct.     *)
+  (* this differs from the ECMA standard (only) in the backspace glyph, some    *)
+  (* terminals in particular the Burroughs TD730/830 range manufactured in the  *)
+  (* 1970s and 1980s depart slightly more. I've found limited open source       *)
+  (* projects that refer to this encoding, and those I've found have attempted  *)
+  (* to "correct" details like the "direction of rotation" of the glyphs for    *)
+  (* the DC1 through DC4 codes.                                                 *)
+  (*                                                                            *)
+  (* Suffixes W, E and B below refer to the variants found in the Wikipedia     *)
+  (* article, the ECMA standard and the Burroughs terminal documentation.       *)
+
+  const
+    nul=  #$2395;                       // ⎕
+    soh=  #$2308;                       // ⌈
+    stx=  #$22A5;                       // ⊥
+    etx=  #$230B;                       // ⌋
+    eot=  #$2301;                       // ⌁
+    enq=  #$22A0;                       // ⊠
+    ack=  #$2713;                       // ✓
+    bel=  #$237E;                       // ⍾
+    bsW=  #$232B;                       // ⌫
+    bsB=  #$2196;                       // ↖ The ECMA glyph is slightly curved
+    bs=   bsB;                          //   and has no Unicode representation.
+    ht=   #$2AAB;                       // ⪫
+    lf=   #$2261;                       // ≡
+    vt=   #$2A5B;                       // ⩛
+    ff=   #$21A1;                       // ↡
+    crW=  #$2aaa;                       // ⪪ ECMA the same
+    crB=  #$25bf;                       // ▿
+    cr=   crW;
+    so=   #$2297;                       // ⊗
+    si=   #$2299;                       // ⊙
+    dle=  #$229F;                       // ⊟
+    dc1=  #$25F7;                       // ◷ Nota bene: these rotate deosil
+    dc2=  #$25F6;                       // ◶
+    dc3=  #$25F5;                       // ◵
+    dc4=  #$25F4;                       // ◴
+    nak=  #$237B;                       // ⍻
+    syn=  #$238D;                       // ⎍
+    etb=  #$22A3;                       // ⊣
+    can=  #$29D6;                       // ⧖
+    em=   #$237F;                       // ⍿
+    sub=  #$2426;                       // ␦
+    esc=  #$2296;                       // ⊖
+    fs=   #$25F0;                       // ◰ Nota bene: these rotate widdershins
+    gsW=  #$25F1;                       // ◱ ECMA the same
+    gsB=  #$25b5;                       // ▵
+    gs=   gsW;
+    rsW=  #$25F2;                       // ◲ ECMA the same
+    rsB=  #$25c3;                       // ◃
+    rs=   rsW;
+    usW=  #$25F3;                       // ◳ ECMA the same
+    usB=  #$25b9;                       // ▹
+    us=   usW;
+    del=  #$2425;                       // ␥
+    bar=  #$033c;                       // ̼'
+
+(* Not represented above is a Burroughs glyph for ETX, which in the material    *)
+(* available to me appears indistinguisable from CAN. If anybody has variant    *)
+(* glyphs from other manufacturers please contribute.                           *)
+
+  var
+    i, test, masked: integer;
+
+  begin
+    result := str;
+
+  (* This should probably be recoded to use a persistent table, but doing it    *)
+  (* this way results in no lookup for plain text which is likely to be the     *)
+  (* bulk of the output. I'm not making any assumptions about the Unicode       *)
+  (* characters being sequential so that this code can be used both for control *)
+  (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
+  (* want to adjust them she can do so.                                         *)
+
+    for i := Length(result) downto 1 do begin
+      test := Ord(result[i]);
+      if c1Underbar then
+        masked := test and $7f          (* Handle both C0 and C1 in one operation *)
+      else
+        masked := test;
+      case masked of
+        $00: result[i] := nul;
+        $01: result[i] := soh;
+        $02: result[i] := stx;
+        $03: result[i] := etx;
+        $04: result[i] := eot;
+        $05: result[i] := enq;
+        $06: result[i] := ack;
+        $07: result[i] := bel;
+        $08: result[i] := bs;
+        $09: result[i] := ht;
+        $0a: result[i] := lf;
+        $0b: result[i] := vt;
+        $0c: result[i] := ff;
+        $0d: result[i] := cr;
+        $0e: result[i] := so;
+        $0f: result[i] := si;
+        $10: result[i] := dle;
+        $11: result[i] := dc1;
+        $12: result[i] := dc2;
+        $13: result[i] := dc3;
+        $14: result[i] := dc4;
+        $15: result[i] := nak;
+        $16: result[i] := syn;
+        $17: result[i] := etb;
+        $18: result[i] := can;
+        $19: result[i] := em;
+        $1a: result[i] := sub;
+        $1b: result[i] := esc;
+        $1c: result[i] := fs;
+        $1d: result[i] := gs;
+        $1e: result[i] := rs;
+        $1f: result[i] := us;
+        $7f: result[i] := del
+      otherwise
+      end;
+      if c1Underbar and                 (* Now fix changed C1 characters        *)
+                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
+                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
+        Insert(bar, result, i + 1)
+    end
+  end { withIso2047 } ;
+
+
+  (* Look at the line index cl in a TStringList. Assume that at the start there
+    will be a line number and padding occupying nl characters, after that will
+    be text. Convert the text to hex possibly inserting extra lines after the
+    one being processed, only the first (i.e. original) line has a line number.
+  *)
+  procedure expandAsHex(var stringList: TStringList; currentLine, lineNumberLength: integer);
+
+  var
+    lineNumberAsText,     scratch     : string;
+    dataAsByteArray: TBytes;
+    lengthLastBlock, startLastBlock: integer;
+
+
+    (* Recursively process the byte array from the end to the beginning. All
+      lines are inserted immediately after the original current line, except for
+      the final line processed which overwrites the original.
+    *)
+    procedure hexLines(start, bytes: integer);
+
+
+      (* The parameter is a line number as text or an equivalent run of spaces.
+        The result is a line of hex + ASCII data.
+      *)
+      function oneHexLine(const lineNum: string): widestring;
+
+      var
+        i: integer;
+
+      begin
+        result := lineNum;
+        for i := 0 to 15 do
+          if i < bytes then
+            result += LowerCase(HexStr(dataAsByteArray[start + i], 2)) + ' '
+          else
+            result += '   ';
+        result += ' ';                  (* Between hex and ASCII                *)
+        for i := 0 to 15 do
+          if i < bytes then
+            case dataAsByteArray[start + i] of
+              $20..$7e: result += Chr(dataAsByteArray[start + i])
+            otherwise
+              result += #$00B7          // ·
+            end
+      end { oneHexLine } ;
+
+
+    begin
+      if start = 0 then
+        stringList[currentLine] := oneHexLine(lineNumberAsText)
+      else begin
+        stringList.insert(currentLine + 1, oneHexLine(PadLeft('', Length(lineNumberAsText))));
+        hexLines(start - 16, 16)
+      end
+    end { hexLines } ;
+
+
+  begin
+    if lineNumberLength = 0 then begin
+      lineNumberAsText := '';
+      dataAsByteArray := BytesOf(Copy(stringList[currentLine], 1,
+                                Length(stringList[currentLine])))
+    end else begin                      (* Remember one extra space after number *)
+      lineNumberAsText := Copy(stringList[currentLine], 1, lineNumberLength + 1);
+      dataAsByteArray := BytesOf(Copy(stringList[currentLine], lineNumberLength + 2,
+                                Length(stringList[currentLine]) - (lineNumberLength + 1)))
+    end;
+    lengthLastBlock := Length(dataAsByteArray) mod 16;
+    startLastBlock := Length(dataAsByteArray) - lengthLastBlock;
+    hexLines(startLastBlock, lengthLastBlock)
+  end { expandAsHex } ;
+
+
 begin
   if ttyHandle = handleUnopened then begin (* Do this at first output only      *)
     //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.AddOutput Calling consoleSizeChanged']);
     consoleSizeChanged
   end;
-  while Memo1.Lines.Count > 5000 do
+
+(* Get the maximum number of lines to be displayed from the user interface,     *)
+(* work out how much space is needed to display a line number, and if necessary *)
+(* trim the amount of currently-stored text.                                    *)
+
+  try
+    lineLimit := StrToInt(Trim(MaskEdit1.Text))
+  except
+    MaskEdit1.Text := '5000';
+    lineLimit := 5000
+  end;
+  if CheckGroupRight.Checked[0] then    (* Line numbers?                        *)
+    case lineLimit + fFirstLine - 1 of
+      0..999:          numLength := 3;
+      1000..99999:     numLength := 5;
+      100000..9999999: numLength := 7
+    otherwise
+      numLength := 9
+    end
+  else
+    numLength := 0;
+  Memo1.Lines.BeginUpdate;
+  while Memo1.Lines.Count > lineLimit do
     Memo1.Lines.Delete(0);
 
-// Working note: make any adjustment to the number of lines etc. before we
-// start to add text which might include escape handling.
+(* Use an intermediate buffer to process the line or potentially lines of text  *)
+(* passed as the parameter; where formatting as hex breaks it up into multiple  *)
+(* lines, the line number is blanked on the synthetic ones. When lines or lists *)
+(* of lines are processed in reverse it is because an indeterminate number of   *)
+(* insertions (e.g. Unicode combining diacritics or extended hex output) may be *)
+(* inserted after the current index.                                            *)
+(*                                                                              *)
+(* This might look like a bit of a palaver, but a standard memo might exhibit   *)
+(* "interesting" behavior once the amount of text causes it to start scrolling  *)
+(* so having an intermediate that can be inspected might be useful.             *)
 
-  Memo1.Text:=Memo1.Text+AText;
-  Memo1.SelStart := length(Memo1.Text);
-end;
+  buffer := TStringList.Create;
+  try
+    buffer.Text := AText;     (* Decides what line breaks it wants to swallow   *)
+    if buffer.Count = 1 then
+      i := 12345              (* Good place for a breakpoint                    *)
+    else
+      i := 67890;             (* Another good place for a breakpoint            *)
+    case RadioGroupRight.ItemIndex of
+      1: for i := 0 to buffer.Count - 1 do
+           buffer[i] := withControlPictures(buffer[i], CheckGroupRight.Checked[1]);
+      2: for i := 0 to buffer.Count - 1 do
+           buffer[i] := withIso2047(buffer[i], CheckGroupRight.Checked[1])
+    otherwise
+    end;
+    for i := 0 to buffer.Count - 1 do begin             (* Line numbers         *)
+      if numLength > 0 then
+        buffer[i] := PadLeft(IntToStr(fFirstLine), numLength) + ' ' + buffer[i];
+      fFirstLine += 1
+    end;
+    if RadioGroupRight.ItemIndex = 3 then (* Expand hex line-by-line in reverse *)
+      for i := buffer.Count - 1 downto 0 do
+        expandAsHex(buffer, i, numLength);
 
+(* Add the buffered text to the visible control(s), and clean up.               *)
+
+    Memo1.Lines.AddStrings(buffer)
+  finally
+    buffer.Free;
+    Memo1.Lines.EndUpdate
+  end;
+  Memo1.SelStart := length(Memo1.Text)
+end { TPseudoConsoleDlg.AddOutput } ;
+
+
 procedure TPseudoConsoleDlg.Clear;
+
 begin
   //DebugLn(DBG_VERBOSE, ['TPseudoConsoleDlg.Clear Calling FormResize']);
-  FormResize(nil);                      (* Safe during IDE initialisation       *)
-  Memo1.Text := '';
-end;
+  Memo1.Lines.BeginUpdate;
+  try
+    FormResize(nil);                    (* Safe during IDE initialisation       *)
+    Memo1.Text := ''
+  finally
+    Memo1.Lines.EndUpdate;
+  end;
+  fFirstLine := 1
+end { TPseudoConsoleDlg.Clear } ;
 
+
 {$R *.lfm}
 
 initialization
Index: debugger/test/watchconsolesize.pas
===================================================================
--- debugger/test/watchconsolesize.pas	(revision 58550)
+++ debugger/test/watchconsolesize.pas	(working copy)
@@ -53,6 +53,8 @@
 
 
 begin
+  WriteLn('This header line comprises 50 characters plus EOL.');
+  WriteLn;
   WriteLn('Press key to terminate.'); // http://ars.userfriendly.org/cartoons/?id=20030128
   reportSize;
   if not hookWinch() then
Index: ide/lazarus.lpi
===================================================================
--- ide/lazarus.lpi	(revision 58550)
+++ ide/lazarus.lpi	(working copy)
@@ -1429,10 +1429,10 @@
       <OtherUnitFiles Value="frames;../converter;../debugger;../debugger/frames;../packager;../designer;../packager/frames;../ide"/>
       <UnitOutputDirectory Value="$(LazarusDir)/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
     </SearchPaths>
-    <CompileReasons Compile="False" Build="False" Run="False"/>
+    <CompileReasons Run="False"/>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="2">
+    <Exceptions Count="3">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -1439,6 +1439,9 @@
       <Item2>
         <Name Value="ECodetoolError"/>
       </Item2>
+      <Item3>
+        <Name Value="EReadError"/>
+      </Item3>
     </Exceptions>
   </Debugging>
 </CONFIG>

Mark Morgan Lloyd

2018-07-17 11:25

reporter   ~0109536

New diff uploaded which is against revision 58550. I've got very limited ability to test this against Windows at the moment, and none against a Mac.

Martin Friebe

2018-07-18 18:37

manager   ~0109564

Unfortunately your patch undoes the changes in svn that made it compile on MacOs.

In svn, ifdef are based on
{$IFDEF linux} {$DEFINE DBG_ENABLE_TERMINAL} {$ENDIF}

And not on "ifdef unix"

I fixed this (again). Make sure you merge this correctly with your version.

--
Patch applied.

Mark Morgan Lloyd

2018-07-18 19:46

reporter   ~0109565

Last edited: 2018-07-18 21:46

View 2 revisions

Thanks, and sorry about the dud define. Testing with a completely clean copy, appears OK here.

Mark Morgan Lloyd

2018-07-21 13:00

reporter  

debug-console-fixes.diff (6,618 bytes)
Index: debugger/pseudoterminaldlg.pp
===================================================================
--- debugger/pseudoterminaldlg.pp	(revision 58584)
+++ debugger/pseudoterminaldlg.pp	(working copy)
@@ -367,7 +367,7 @@
   (* Translate C0 control codes to "control pictures", and optionally C1 codes
     to the same glyph but with an underbar.
   *)
-  function withControlPictures(const str: widestring; c1Underbar: boolean): widestring;
+  function withControlPictures(const str: string; c1Underbar: boolean): widestring;
 
   const
     nul= #$2400;                        // ␀
@@ -407,9 +407,10 @@
 
   var
     i, test, masked: integer;
+    changed: boolean;
 
   begin
-    result := str;
+    SetLength(result, Length(str));
 
   (* This should probably be recoded to use a persistent table, but doing it    *)
   (* this way results in no lookup for plain text which is likely to be the     *)
@@ -418,12 +419,13 @@
   (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
   (* want to adjust them he can do so.                                          *)
 
-    for i := Length(result) downto 1 do begin
-      test := Ord(result[i]);
+    for i := Length(str) downto 1 do begin
+      test := Ord(str[i]);
       if c1Underbar then
         masked := test and $7f          (* Handle both C0 and C1 in one operation *)
       else
         masked := test;
+      changed := true;
       case masked of
         $00: result[i] := nul;
         $01: result[i] := soh;
@@ -459,11 +461,12 @@
         $1f: result[i] := us;
         $7f: result[i] := del
       otherwise
+        result[i] := Chr(test);
+        changed := false;
       end;
-      if c1Underbar and                 (* Now fix changed C1 characters        *)
-                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
-                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
-        Insert(bar, result, i + 1)
+      if c1Underbar and changed and     (* Now fix changed C1 characters        *)
+                                (masked <> test) then
+        Insert(bar, result, i)
     end
   end { withControlPictures } ;
 
@@ -471,7 +474,7 @@
   (* Translate C0 control codes to "pretty pictures", and optionally C1 codes
     to the same glyph but with an underbar.
   *)
-  function withIso2047(const str: widestring; c1Underbar: boolean): widestring;
+  function withIso2047(const str: string; c1Underbar: boolean): widestring;
 
   (* I've not got access to a pukka copy of ISO-2047, so like (it appears)      *)
   (* almost everybody else I'm assuming that the Wikipedia page is correct.     *)
@@ -537,9 +540,10 @@
 
   var
     i, test, masked: integer;
+    changed: boolean;
 
   begin
-    result := str;
+    SetLength(result, Length(str));
 
   (* This should probably be recoded to use a persistent table, but doing it    *)
   (* this way results in no lookup for plain text which is likely to be the     *)
@@ -548,12 +552,13 @@
   (* pictures and ISO-2047 glyphs, and so that if somebody has (good) reason to *)
   (* want to adjust them she can do so.                                         *)
 
-    for i := Length(result) downto 1 do begin
-      test := Ord(result[i]);
+    for i := Length(str) downto 1 do begin
+      test := Ord(str[i]);
       if c1Underbar then
         masked := test and $7f          (* Handle both C0 and C1 in one operation *)
       else
         masked := test;
+      changed := true;
       case masked of
         $00: result[i] := nul;
         $01: result[i] := soh;
@@ -589,15 +594,44 @@
         $1f: result[i] := us;
         $7f: result[i] := del
       otherwise
+        result[i] := Chr(test);
+        changed := false;
       end;
-      if c1Underbar and                 (* Now fix changed C1 characters        *)
-                (Ord(result[i]) <> test) and (* Was changed, so must be C0 or C1 *)
-                (masked <> test) then   (* MSB masked so must be C1, add bar    *)
-        Insert(bar, result, i + 1)
+      if c1Underbar and changed and     (* Now fix changed C1 characters        *)
+                                (masked <> test) then
+        Insert(bar, result, i)
     end
   end { withIso2047 } ;
 
 
+  (* Convert the string that's arrived from GDB etc. into UTF-8. In this case
+    it's mostly a dummy operation, except that there might be widget-set-specific
+    hacks.
+  *)
+  function widen(const str: string): widestring;
+
+  const
+    dot= #$00B7;                        // ·
+
+  var
+    i: integer;
+
+  begin
+    SetLength(result, Length(str));
+    for i := Length(str) downto 1 do
+      case str[i] of
+        ' ': result[i] := ' ';          (* Satisfy syntax requirement           *)
+        #$00: result[i] := dot;         (* GTK2 really doesn't like seeing this *)
+//        #$01..#$0f:   result[i] := dot;
+//        #$10..#$1f: result[i] := dot;
+//        #$7f:       result[i] := dot;
+//        #$80..#$ff: result[i] := dot
+      otherwise
+        result[i] := str[i]
+      end
+  end { widen } ;
+
+
   (* Look at the line index cl in a TStringList. Assume that at the start there
     will be a line number and padding occupying nl characters, after that will
     be text. Convert the text to hex possibly inserting extra lines after the
@@ -606,7 +640,7 @@
   procedure expandAsHex(var stringList: TStringList; currentLine, lineNumberLength: integer);
 
   var
-    lineNumberAsText,     scratch     : string;
+    lineNumberAsText: string;
     dataAsByteArray: TBytes;
     lengthLastBlock, startLastBlock: integer;
 
@@ -664,7 +698,10 @@
       dataAsByteArray := BytesOf(Copy(stringList[currentLine], lineNumberLength + 2,
                                 Length(stringList[currentLine]) - (lineNumberLength + 1)))
     end;
-    lengthLastBlock := Length(dataAsByteArray) mod 16;
+    if (Length(dataAsByteArray) > 0) and ((Length(dataAsByteArray) mod 16) = 0) then
+      lengthLastBlock := 16
+    else
+      lengthLastBlock := Length(dataAsByteArray) mod 16;
     startLastBlock := Length(dataAsByteArray) - lengthLastBlock;
     hexLines(startLastBlock, lengthLastBlock)
   end { expandAsHex } ;
@@ -719,6 +756,8 @@
     else
       i := 67890;             (* Another good place for a breakpoint            *)
     case RadioGroupRight.ItemIndex of
+      0: for i := 0 to buffer.Count - 1 do
+           buffer[i] := widen(buffer[i]);
       1: for i := 0 to buffer.Count - 1 do
            buffer[i] := withControlPictures(buffer[i], CheckGroupRight.Checked[1]);
       2: for i := 0 to buffer.Count - 1 do
debug-console-fixes.diff (6,618 bytes)

Mark Morgan Lloyd

2018-07-21 13:04

reporter   ~0109602

Last edited: 2018-07-21 17:29

View 2 revisions

Fixes for the GTK2 crash and some cosmetics attached.

Crash was caused by GTK2 seeing a $00, not a high character. I can't find a compile-time define that shows which widget set the IDE is being built for, so what I've done also applies to Qt etc. where it's not strictly necessary. Is GetBuildLCLWidgetType a safe test in this context?

Is there a concise/efficient way of converting from a (numeric) codepoint (odd character in GDB etc. output) to a widechar?

Martin Friebe

2018-07-21 23:38

manager   ~0109613

debug-console-fixes.diff applied in r58589

Mark Morgan Lloyd

2018-07-22 10:49

reporter  

debug-console-fixes2.diff (3,696 bytes)
Index: debugger/pseudoterminaldlg.pp
===================================================================
--- debugger/pseudoterminaldlg.pp	(revision 58593)
+++ debugger/pseudoterminaldlg.pp	(working copy)
@@ -95,7 +95,7 @@
 uses
   SysUtils, StrUtils, LazLoggerBase
 {$IFDEF DBG_ENABLE_TERMINAL}
-  , Unix, BaseUnix, termio
+  , Unix, BaseUnix, termio, LCLPlatformDef, InterfaceBase
 {$ENDIF DBG_ENABLE_TERMINAL}
   ;
 
@@ -604,9 +604,9 @@
   end { withIso2047 } ;
 
 
-  (* Convert the string that's arrived from GDB etc. into UTF-8. In this case
-    it's mostly a dummy operation, except that there might be widget-set-specific
-    hacks.
+  (* Convert the string with unknown encoding that's arrived from GDB etc. into
+    UTF-8. In this case it's mostly a dummy operation, except that there might
+    be widget-set-specific hacks.
   *)
   function widen(const str: string): widestring;
 
@@ -618,17 +618,30 @@
 
   begin
     SetLength(result, Length(str));
-    for i := Length(str) downto 1 do
-      case str[i] of
-        ' ': result[i] := ' ';          (* Satisfy syntax requirement           *)
-        #$00: result[i] := dot;         (* GTK2 really doesn't like seeing this *)
-//        #$01..#$0f:   result[i] := dot;
-//        #$10..#$1f: result[i] := dot;
-//        #$7f:       result[i] := dot;
-//        #$80..#$ff: result[i] := dot
-      otherwise
-        result[i] := str[i]
-      end
+    case GetDefaultLCLWidgetType() of
+      lpGtk2:   for i := Length(str) downto 1 do
+                  case str[i] of
+                    #$00: result[i] := dot (* GTK2 really doesn't like seeing this *)
+                  otherwise
+                    result[i] := str[i]
+                  end
+    otherwise
+
+(* I've left this doing it "the long way" to make it easy to rough out a filter *)
+(* for a hitherto-unhandled widget set.                                         *)
+
+      for i := Length(str) downto 1 do
+        case str[i] of
+          ' ': result[i] := ' ';          (* Satisfy syntax requirement           *)
+//          #$00:       result[i] := dot;
+//          #$01..#$0f: result[i] := dot;
+//          #$10..#$1f: result[i] := dot;
+//          #$7f:       result[i] := dot;
+//          #$80..#$ff: result[i] := dot
+        otherwise
+          result[i] := str[i]
+        end
+    end
   end { widen } ;
 
 
Index: debugger/test/testconsolescroll.pas
===================================================================
--- debugger/test/testconsolescroll.pas	(revision 58593)
+++ debugger/test/testconsolescroll.pas	(working copy)
@@ -1,9 +1,10 @@
 program TestConsoleScroll;
 
 (* This console-mode program for Linux or other unix implementations outputs	*)
-(* 100 numbered lines, followed by all 256 8-bit characters as a block. The	*)
-(* lines should be presented without intervening blanks, the character block	*)
-(* should make sense provided that a formatted console style is selected.	*)
+(* 100 numbered lines, followed by all 256 8-bit characters as a block plus a   *)
+(* couple of explicit currency symbols. The lines should be presented without   *)
+(* intervening blanks, the character block should make sense provided that a    *)
+(* formatted console style is selected.	                                        *)
 (*										*)
 (* It DOES NOT attempt any formatted output using escape sequences etc. MarkMLl	*)
 
@@ -18,10 +19,13 @@
     WriteLn(i);
   WriteLn;
   for i := 0 to 15 do begin
-    for j := 1 to 15 do
+    for j := 0 to 15 do
       Write(Chr(16 * i + j));
     WriteLn
   end;
-  WriteLn 
+  WriteLn;
+  WriteLn('UK currency symbol: £');
+  WriteLn('EU currency symbol: €');
+  WriteLn
 end.
   

Mark Morgan Lloyd

2018-07-22 10:52

reporter   ~0109624

Take widget set into account when suppressing $00 etc., needs to be done for GTK2 but not Qt. Minor fix to one of the test programs, also add explicit output of Sterling and Euro characters to the end of it.

Martin Friebe

2019-02-16 21:31

manager   ~0114198

Can you check if this is related: 0035071

Mark Morgan Lloyd

2019-02-23 18:59

reporter   ~0114371

Generally looking good from my POV, you've done a nice job sorting out the UTF8 issues that I balked at. Suggest we close this one.

Apologies that I'm quiet and off the mailing list.

Mark Morgan Lloyd

2019-02-24 21:46

reporter   ~0114387

Looking good.

Issue History

Date Modified Username Field Change
2018-07-01 15:32 Mark Morgan Lloyd New Issue
2018-07-01 19:03 Martin Friebe Relationship added related to 0033652
2018-07-01 19:10 Martin Friebe Note Added: 0109163
2018-07-01 19:12 Martin Friebe Note Edited: 0109163 View Revisions
2018-07-01 21:57 Mark Morgan Lloyd Note Added: 0109168
2018-07-02 11:37 Mark Morgan Lloyd Note Edited: 0109168 View Revisions
2018-07-02 12:55 Martin Friebe Note Added: 0109184
2018-07-02 13:30 Mark Morgan Lloyd Note Added: 0109188
2018-07-02 18:17 Martin Friebe Note Added: 0109193
2018-07-02 18:22 Martin Friebe Note Edited: 0109193 View Revisions
2018-07-03 16:40 Mark Morgan Lloyd Note Added: 0109207
2018-07-04 11:52 Mark Morgan Lloyd Note Added: 0109214
2018-07-04 12:40 Martin Friebe Note Added: 0109216
2018-07-04 12:40 Martin Friebe Note Edited: 0109216 View Revisions
2018-07-04 13:34 Mark Morgan Lloyd Note Added: 0109218
2018-07-04 17:49 Martin Friebe File Added: ttycontrol.patch
2018-07-04 18:03 Martin Friebe Note Added: 0109219
2018-07-04 18:05 Martin Friebe Note Edited: 0109219 View Revisions
2018-07-04 20:51 Mark Morgan Lloyd Note Added: 0109221
2018-07-04 22:59 Martin Friebe Note Added: 0109224
2018-07-05 11:40 Mark Morgan Lloyd Note Added: 0109228
2018-07-05 11:53 Mark Morgan Lloyd Note Edited: 0109228 View Revisions
2018-07-05 12:14 Martin Friebe Note Added: 0109229
2018-07-06 00:45 Mark Morgan Lloyd Note Added: 0109231
2018-07-06 11:15 Mark Morgan Lloyd Note Edited: 0109231 View Revisions
2018-07-07 11:51 Mark Morgan Lloyd Note Edited: 0109231 View Revisions
2018-07-07 16:53 Mark Morgan Lloyd File Added: debug-console-winch-support.diff
2018-07-07 16:55 Mark Morgan Lloyd Note Added: 0109279
2018-07-07 18:12 Martin Friebe Assigned To => Martin Friebe
2018-07-07 18:12 Martin Friebe Status new => assigned
2018-07-10 17:44 Martin Friebe Note Added: 0109347
2018-07-10 17:52 Martin Friebe Note Added: 0109348
2018-07-10 19:55 Mark Morgan Lloyd Note Added: 0109350
2018-07-10 20:21 Mark Morgan Lloyd Note Edited: 0109350 View Revisions
2018-07-10 22:25 Martin Friebe Note Added: 0109353
2018-07-11 21:45 Mark Morgan Lloyd Note Added: 0109376
2018-07-11 22:57 Martin Friebe Note Added: 0109380
2018-07-11 23:52 Mark Morgan Lloyd Note Added: 0109384
2018-07-13 13:00 Mark Morgan Lloyd File Added: debug-console-unformatted.diff
2018-07-13 13:18 Mark Morgan Lloyd Note Added: 0109424
2018-07-13 15:13 Martin Friebe File Added: debug-console-unformatted-new.patch
2018-07-13 15:19 Martin Friebe Note Added: 0109426
2018-07-13 15:21 Martin Friebe Note Edited: 0109426 View Revisions
2018-07-13 15:22 Martin Friebe Note Edited: 0109426 View Revisions
2018-07-13 15:31 Martin Friebe Note Edited: 0109426 View Revisions
2018-07-13 15:33 Martin Friebe Note Edited: 0109426 View Revisions
2018-07-13 15:34 Martin Friebe Note Edited: 0109426 View Revisions
2018-07-13 15:35 Martin Friebe Note Edited: 0109426 View Revisions
2018-07-13 15:46 Martin Friebe Note Added: 0109427
2018-07-13 16:37 Mark Morgan Lloyd Note Added: 0109429
2018-07-13 16:46 Mark Morgan Lloyd Note Edited: 0109429 View Revisions
2018-07-14 16:58 Mark Morgan Lloyd Note Added: 0109454
2018-07-14 17:04 Mark Morgan Lloyd Note Edited: 0109454 View Revisions
2018-07-14 19:14 Martin Friebe Note Added: 0109458
2018-07-14 19:42 Mark Morgan Lloyd Note Added: 0109459
2018-07-14 20:02 Mark Morgan Lloyd Note Edited: 0109459 View Revisions
2018-07-15 18:29 Mark Morgan Lloyd File Added: debug-console-unformatted-new2.patch
2018-07-15 18:33 Mark Morgan Lloyd Note Added: 0109494
2018-07-16 13:22 Martin Friebe Note Added: 0109518
2018-07-16 15:13 Mark Morgan Lloyd Note Added: 0109523
2018-07-16 15:26 Martin Friebe Note Added: 0109524
2018-07-17 11:24 Mark Morgan Lloyd File Added: debug-console-unformatted2.diff
2018-07-17 11:25 Mark Morgan Lloyd Note Added: 0109536
2018-07-18 18:37 Martin Friebe Note Added: 0109564
2018-07-18 19:46 Mark Morgan Lloyd Note Added: 0109565
2018-07-18 21:46 Mark Morgan Lloyd Note Edited: 0109565 View Revisions
2018-07-21 13:00 Mark Morgan Lloyd File Added: debug-console-fixes.diff
2018-07-21 13:04 Mark Morgan Lloyd Note Added: 0109602
2018-07-21 17:29 Mark Morgan Lloyd Note Edited: 0109602 View Revisions
2018-07-21 23:38 Martin Friebe Note Added: 0109613
2018-07-22 10:49 Mark Morgan Lloyd File Added: debug-console-fixes2.diff
2018-07-22 10:52 Mark Morgan Lloyd Note Added: 0109624
2019-02-16 21:29 Martin Friebe Relationship added related to 0035071
2019-02-16 21:31 Martin Friebe LazTarget => -
2019-02-16 21:31 Martin Friebe Note Added: 0114198
2019-02-16 21:31 Martin Friebe Status assigned => feedback
2019-02-23 18:59 Mark Morgan Lloyd Note Added: 0114371
2019-02-23 18:59 Mark Morgan Lloyd Status feedback => assigned
2019-02-23 22:30 Martin Friebe Status assigned => resolved
2019-02-23 22:30 Martin Friebe Resolution open => fixed
2019-02-24 21:46 Mark Morgan Lloyd Note Added: 0114387
2019-02-24 21:46 Mark Morgan Lloyd Status resolved => closed