diff --git a/etc/terminal/gtk2term.pas b/etc/terminal/gtk2term.pas index 5ced81c2..b9b7fc70 100644 --- a/etc/terminal/gtk2term.pas +++ b/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; diff --git a/etc/terminal/terminalctrls.pas b/etc/terminal/terminalctrls.pas index d1e2af36..cf59ddad 100644 --- a/etc/terminal/terminalctrls.pas +++ b/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, 'contents-changed', G_CALLBACK(@TerminalRefresh), 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, '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; diff --git a/src/u_main.lfm b/src/u_main.lfm index 976fe529..ae8136d9 100644 --- a/src/u_main.lfm +++ b/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 diff --git a/src/u_term.lfm b/src/u_term.lfm index 7e266485..39e0a66e 100644 --- a/src/u_term.lfm +++ b/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 diff --git a/src/u_term.pas b/src/u_term.pas index 642b041f..eb960000 100644 --- a/src/u_term.pas +++ b/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. -