terminal, add vscrollbar

etc/terminal/gtk2term.pas

@@ -104,10 +104,13 @@ var
 
   vte_terminal_get_cursor_position: procedure(terminal: PVteTerminal; column: Pglong; row: Pglong); cdecl;
 
-  vte_terminal_get_text_range: function (terminal: PVteTerminal;
+  vte_terminal_get_text_range: function(terminal: PVteTerminal;
     start_row: glong; start_col: glong; end_row: glong; end_col: glong;
     is_selected: TVteSelectionFunc; user_data: Pointer; attributes: PGArray): PChar; cdecl;
 
+  vte_terminal_get_adjustment: function(terminal: PVteTerminal): PGtkAdjustment; cdecl;
+
+
 function Gtk2TermLoad: Boolean;
 
 implementation
@@ -166,6 +169,8 @@ begin
     'vte_terminal_get_cursor_position');
   @vte_terminal_get_text_range:= GetProcAddress(Lib,
     'vte_terminal_get_text_range');
+  @vte_terminal_get_adjustment:= GetProcAddress(Lib,
+    'vte_terminal_get_adjustment');
 
   // assume all or none
   Loaded := @vte_terminal_new <> nil;

etc/terminal/terminalctrls.pas

@@ -17,6 +17,12 @@ uses
 
 type
 
+  TTerminalScrollInfo = record
+    min, max, value: integer;
+  end;
+
+  TTerminalTextScrolled = procedure(sender: TObject; delta: integer) of Object;
+
   TASCIIControlCharacter = (
     HOME  = 1,
     LEFT  = 2,
@@ -43,19 +49,25 @@ type
     {$endif}
     fOnTerminate: TNotifyEvent;
     fOnTerminalVisibleChanged: TNotifyEvent;
+    fOnTerminalTextScrolled: TTerminalTextScrolled;
     fBackgroundColor: TColor;
     fForegroundColor: TColor;
     fSelectedColor: TColor;
     fScrollbackLines: LongWord;
+    fScrollOnOutput: boolean;
+    fScrollOnKeyStroke: boolean;
     procedure setBackgroundColor(value: TColor);
     procedure setForegroundColor(value: TColor);
     procedure setSelectedColor(value: TColor);
     procedure setScrollBackLines(value: LongWord);
+    procedure setScrollOnOutput(value: boolean);
+    procedure setScrollOnKeyStroke(value: boolean);
   protected
     // Only used at design-time.
     procedure Paint; override;
     procedure DoTerminate; virtual;
     procedure DoTerminalVisibleChanged; virtual;
+    procedure DoTerminalTextScrolled(delta: integer); virtual;
     procedure FontChanged(Sender: TObject); override;
   public
     constructor Create(AOwner: TComponent); override;
@@ -68,11 +80,19 @@ type
     procedure copyToClipboard();
     procedure pasteFromClipboard();
     function  getLine(const line: integer): string;
+    function  getWholeText(): string;
     function  getCursorPosition: TPoint;
+    function  getVScrollInfo: TTerminalScrollInfo;
+    procedure setVScrollPosition(i: integer);
   published
     {$ifdef windows}
     property terminalProgram: string read fTermProgram write fTermProgram;
     {$endif}
+    // set if view is scrolled to the back on key stroke
+    property scrollOnOutut: boolean read fScrollOnKeyStroke write setScrollOnKeyStroke default true;
+    // set if view is scrolled to the back on output
+    property scrollOnKeyStroke: boolean read FScrollOnOutput write setScrollOnOutput default true;
+    // set the back buffer in line count
     property scrollbackLines: LongWord read fScrollbackLines write setScrollBackLines default 4096;
     // Background color
     property backgroundColor: TColor read fBackgroundColor write setBackgroundColor default clBlack;
@@ -127,6 +147,7 @@ type
     // Note: The hosted widget is there and visual settings can be applied.
     // In many cases DoFirstShow, OnShow and likes will happen too quickly.
     property OnTerminalVisibleChanged: TNotifyEvent read fOnTerminalVisibleChanged write fOnTerminalVisibleChanged;
+    property OnTextScrolled: TTerminalTextScrolled read fOnTerminalTextScrolled write fOnTerminalTextScrolled;
   end;
 
 function TerminalAvailable: Boolean;
@@ -149,6 +170,14 @@ type
         const AParams: TCreateParams): TLCLIntfHandle; override;
   end;
 
+procedure TerminalCommit(Widget: PGtkWidget; c: gchar; s: guint; user: Pointer); cdecl;
+var
+  Info: PWidgetInfo;
+begin
+  Info := PWidgetInfo(g_object_get_data(PGObject(Widget), 'widgetinfo'));
+  TTerminal(Info.LCLObject).DoTerminalTextScrolled(1);
+end;
+
 procedure TerminalExit(Widget: PGtkWidget; status: gint; user: Pointer); cdecl;
 var
   Info: PWidgetInfo;
@@ -165,6 +194,19 @@ begin
   TTerminal(Info.LCLObject).DoTerminalVisibleChanged;
 end;
 
+function TerminalTextScrolled(Widget: PGtkWidget; event: PGdkEvent; user: Pointer): gboolean; cdecl;
+var
+  Info: PWidgetInfo;
+begin
+  result := false;
+  Info := PWidgetInfo(g_object_get_data(PGObject(Widget), 'widgetinfo'));
+  if event^._type = 31 then //NOTE: should be 7 for scroll ?
+  begin
+    TTerminal(Info.LCLObject).DoTerminalTextScrolled(integer(event^.scroll.direction) and 1);
+    result := false;
+  end;
+end;
+
 class procedure TGtk2WSTerminal.SetCallbacks(const AGtkWidget: PGtkWidget;
   const AWidgetInfo: PWidgetInfo);
 begin
@@ -217,8 +259,10 @@ begin
   Allocation.Width := AParams.Width;
   Allocation.Height := AParams.Height;
   gtk_widget_size_allocate(Info.CoreWidget, @Allocation);
-  g_signal_connect(Info.ClientWidget, 'child-exited', G_CALLBACK(@TerminalExit), nil);
+  g_signal_connect(Info.ClientWidget, 'child-exited',    G_CALLBACK(@TerminalExit), nil);
-  g_signal_connect(Info.ClientWidget, 'contents-changed', G_CALLBACK(@TerminalRefresh), nil);
+  g_signal_connect(Info.ClientWidget, 'contents-changed',G_CALLBACK(@TerminalRefresh), nil);
+  g_signal_connect(Info.ClientWidget, 'scroll-event',    G_CALLBACK(@TerminalTextScrolled), nil);
+  g_signal_connect(Info.ClientWidget, 'commit',          G_CALLBACK(@TerminalCommit), nil);
   SetCallbacks(Info.CoreWidget, Info);
   Result := {%H-}TLCLIntfHandle(Info.CoreWidget);
 end;
@@ -236,6 +280,12 @@ begin
     fOnTerminalVisibleChanged(Self);
 end;
 
+procedure TTerminal.DoTerminalTextScrolled(delta: integer);
+begin
+  if Assigned(fOnTerminalTextScrolled) then
+    fOnTerminalTextScrolled(self, delta);
+end;
+
 {$ifdef windows}
 function ReparentTerminalClbck(wnd: HWND; userp: LPARAM):WINBOOL; stdcall;
 var
@@ -370,6 +420,32 @@ begin
 {$endif}
 end;
 
+function TTerminal.getWholeText(): string;
+{$ifdef hasgtk2term}
+var
+  c: glong;
+  a: PGArray = nil;
+  s: string;
+  i: integer;
+{$endif}
+begin
+  result := '';
+{$ifdef hasgtk2term}
+  if assigned(fTerminalHanlde) and assigned(vte_terminal_get_text_range) then
+  begin
+    c := vte_terminal_get_column_count(fTerminalHanlde);
+    for i:= 0 to high(integer) do
+    begin
+      s := vte_terminal_get_text_range(fTerminalHanlde, i, 0, i, c, @clbckTrueSel, nil, a);
+      if (s.Length <> 0) and (s <> #10) then
+        result += s
+      else
+        break;
+    end;
+  end;
+{$endif}
+end;
+
 function TerminalAvailable: Boolean;
 begin
   {$ifdef hasgtk2term}
@@ -399,6 +475,8 @@ begin
   Font.Height:=11;
   Font.Name:='Monospace';
   fScrollbackLines:=4096;
+  scrollOnOutut:=true;
+  fScrollOnKeyStroke:=true;
 
   {$ifdef windows}
   fTermProgram := 'cmd.exe';
@@ -457,6 +535,38 @@ begin
 {$endif}
 end;
 
+procedure TTerminal.setScrollOnOutput(value: boolean);
+{$ifdef hasgtk2term}
+var
+  v: TGValue;
+begin
+  fScrollOnOutput:=value;
+  if not assigned(FInFo) then
+    exit;
+  v.g_type:= G_TYPE_UINT;
+  v.data[0].v_uint := integer(fScrollOnOutput);
+  g_object_set_property(PGObject(PWidgetInfo(FInfo).ClientWidget), 'scroll-on-output', @v);
+{$else}
+begin
+{$endif}
+end;
+
+procedure TTerminal.setScrollOnKeyStroke(value: boolean);
+{$ifdef hasgtk2term}
+var
+  v: TGValue;
+begin
+  fScrollOnKeyStroke:=value;
+  if not assigned(FInFo) then
+    exit;
+  v.g_type:= G_TYPE_UINT;
+  v.data[0].v_uint := integer(fScrollOnKeyStroke);
+  g_object_set_property(PGObject(PWidgetInfo(FInfo).ClientWidget), 'scroll-on-keystroke', @v);
+{$else}
+begin
+{$endif}
+end;
+
 procedure TTerminal.setBackgroundColor(value: TColor);
 {$ifdef hasgtk2term}
 var
@@ -524,6 +634,38 @@ begin
   {$endif}
 end;
 
+function TTerminal.getVScrollInfo: TTerminalScrollInfo;
+{$ifdef hasgtk2term}
+var
+  a: PGtkAdjustment = nil;
+{$endif}
+begin
+{$ifdef hasgtk2term}
+  if assigned(fTerminalHanlde) and assigned(vte_terminal_get_adjustment) then
+  begin
+    a            := vte_terminal_get_adjustment(fTerminalHanlde);
+    result.max   := round(a^.upper);
+    result.min   := round(a^.lower);
+    result.value := round(a^.value);
+  end;
+{$endif}
+end;
+
+procedure TTerminal.setVScrollPosition(i: integer);
+{$ifdef hasgtk2term}
+var
+  a: PGtkAdjustment = nil;
+{$endif}
+begin
+{$ifdef hasgtk2term}
+  if assigned(fTerminalHanlde) and assigned(vte_terminal_get_adjustment) then
+  begin
+    a := vte_terminal_get_adjustment(fTerminalHanlde);
+    gtk_adjustment_set_value(a, i);
+  end;
+{$endif}
+end;
+
 {$ifdef hasgtk2term}
 initialization
   RegisterTerminal;

src/u_main.lfm

@@ -12,6 +12,7 @@ object MainForm: TMainForm
   OnDropFiles = FormDropFiles
   OnResize = FormResize
   ShowHint = True
+  LCLVersion = '2.0.6.0'
   object mainMenu: TMainMenu
     top = 1
     object MenuItem1: TMenuItem

src/u_term.lfm

@@ -14,9 +14,32 @@ inherited TermWidget: TTermWidget
     inherited Content: TPanel
       Height = 260
       Width = 674
+      ClientHeight = 260
+      ClientWidth = 674
       OnPaint = ContentPaint
+      object ScrollBar1: TScrollBar[0]
+        Left = 661
+        Height = 260
+        Top = 0
+        Width = 13
+        Align = alRight
+        Kind = sbVertical
+        PageSize = 0
+        TabOrder = 0
+        OnScroll = ScrollBar1Scroll
+      end
+      object Panel1: TPanel[1]
+        Left = 0
+        Height = 260
+        Top = 0
+        Width = 661
+        Align = alClient
+        BevelOuter = bvNone
+        TabOrder = 1
+      end
     end
     inherited toolbar: TDexedToolBar
+      Height = 30
       Width = 666
     end
   end

src/u_term.pas

@@ -6,9 +6,9 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, LCLType,
-  ActnList, LMessages,
+  ActnList, LMessages, ExtCtrls, Menus, StdCtrls,
   u_widget, TerminalCtrls, u_interfaces, u_writableComponent, u_observer,
-  u_common, u_synmemo;
+  u_common, u_synmemo, u_dsgncontrols;
 
 type
 
@@ -71,14 +71,20 @@ type
   { TTermWidget }
 
   TTermWidget = class(TDexedWidget, IDocumentObserver, IProjectObserver, IMiniExplorerObserver)
+    Panel1: TPanel;
+    ScrollBar1: TScrollBar;
     procedure ContentPaint(Sender: TObject);
     procedure FormShortCut(var Msg: TLMKey; var Handled: Boolean);
+    procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
+      var ScrollPos: Integer);
   private
     fTerm: TTerminal;
     fOpts: TTerminalOptions;
     fLastCheckedDirectory: string;
     fNeedApplyChanges: boolean;
     procedure checkDirectory(const dir: string);
+    procedure updateScrollBar();
+    procedure terminalTextScrolled(sender: TObject; delta: integer);
 
     procedure docNew(document: TDexedMemo);
     procedure docFocused(document: TDexedMemo);
@@ -251,10 +257,11 @@ begin
   inherited;
 
   toolbarVisible:=false;
-  fTerm := TTerminal.Create(self);
+  fTerm := TTerminal.Create(Panel1);
   fTerm.Align:= alClient;
   fTerm.BorderSpacing.Around:=4;
-  fterm.Parent := self;
+  fterm.Parent := Panel1;
+  fTerm.OnTextScrolled:= @terminalTextScrolled;
 
   fOpts:= TTerminalOptions.Create(self);
 
@@ -283,9 +290,11 @@ begin
   fLastCheckedDirectory := dir;
   fTerm.SendControlChar(TASCIIControlCharacter.HOME);
   fTerm.SendControlChar(TASCIIControlCharacter.VT);
+  fTerm.SendControlChar(TASCIIControlCharacter.LF);
   fNeedApplyChanges := true;
   fOpts.applyChanges;
   fTerm.Command('cd ' + dir);
+  updateScrollBar();
 end;
 
 procedure TTermWidget.SetVisible(Value: boolean);
@@ -303,6 +312,22 @@ begin
   fOpts.applyChanges;
 end;
 
+procedure TTermWidget.terminalTextScrolled(sender: TObject; delta: integer);
+begin
+  updateScrollBar();
+end;
+
+procedure TTermWidget.updateScrollBar();
+var
+  i: TTerminalScrollInfo;
+begin
+  if not visible or fTerm.isNil then
+    exit;
+  i := fTerm.getVScrollInfo();
+  ScrollBar1.Max := i.max;
+  ScrollBar1.Position := i.value;
+end;
+
 procedure TTermWidget.FormShortCut(var Msg: TLMKey; var Handled: Boolean);
 var
   s: TShortCut;
@@ -321,6 +346,12 @@ begin
   end;
 end;
 
+procedure TTermWidget.ScrollBar1Scroll(Sender: TObject;
+  ScrollCode: TScrollCode; var ScrollPos: Integer);
+begin
+  fTerm.setVScrollPosition(ScrollPos);
+end;
+
 procedure TTermWidget.mnexDirectoryChanged(const directory: string);
 begin
   if fOpts.followExplorer and directory.dirExists and
@@ -379,4 +410,3 @@ begin
 end;
 
 end.
-