forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

terminal, add vscrollbar

This commit is contained in:
Basile Burg 2020-03-06 23:36:32 +01:00
parent 4c67e10673
commit a60bca7c96
5 changed files with 209 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
etc/terminal/gtk2term.pas
View File

@ -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;

146
etc/terminal/terminalctrls.pas
View File

@ -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;

1
src/u_main.lfm
View File

@ -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

23
src/u_term.lfm
View File

@ -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

40
src/u_term.pas
View File

@ -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.