terminal, use ascii cc to clear temp line before auto checkdir

This commit is contained in:
Basile Burg 2020-03-06 18:20:33 +01:00
parent af4e2b93f1
commit 4c67e10673
3 changed files with 102 additions and 25 deletions

View File

@ -49,6 +49,8 @@ const
type
TGSpawnChildSetupFunc = procedure(user_data: Pointer); cdecl;
PVteTerminal = ^TVteTerminal;
TVteTerminal = record
widget: PGtkWidget;
@ -56,6 +58,8 @@ type
VTE_TERMINAL = PVteTerminal;
TVteSelectionFunc = function(terminal: PVteTerminal; column: glong; row: glong; data: Pointer): gboolean; cdecl;
var
vte_terminal_new: function: PGtkWidget; cdecl;
@ -98,6 +102,12 @@ var
vte_terminal_get_column_count: function(terminal: PVteTerminal): glong; cdecl;
vte_terminal_get_cursor_position: procedure(terminal: PVteTerminal; column: Pglong; row: Pglong); cdecl;
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;
function Gtk2TermLoad: Boolean;
implementation
@ -152,6 +162,10 @@ begin
'vte_terminal_get_row_count');
@vte_terminal_get_column_count:= GetProcAddress(Lib,
'vte_terminal_get_column_count');
@vte_terminal_get_cursor_position:= GetProcAddress(Lib,
'vte_terminal_get_cursor_position');
@vte_terminal_get_text_range:= GetProcAddress(Lib,
'vte_terminal_get_text_range');
// assume all or none
Loaded := @vte_terminal_new <> nil;

View File

@ -17,6 +17,19 @@ uses
type
TASCIIControlCharacter = (
HOME = 1,
LEFT = 2,
ETX = 3, // interrupt, clear temp line
SUPR = 4,
&END = 5,
RIGHT = 6,
BS = 8,
LF = 10,
VT = 11, // delete from cursor pos to end of line
CR = 13
);
TTerminal = class(TCustomControl)
private
FInfo: Pointer;
@ -51,8 +64,11 @@ type
procedure Reparent;
// Sends a command, as it would be manually typed. Line feed is automatically added.
procedure Command(const data: string);
procedure SendControlChar(const cc: TASCIIControlCharacter);
procedure copyToClipboard();
procedure pasteFromClipboard();
function getLine(const line: integer): string;
function getCursorPosition: TPoint;
published
{$ifdef windows}
property terminalProgram: string read fTermProgram write fTermProgram;
@ -303,6 +319,17 @@ begin
{$endif}
end;
procedure TTerminal.SendControlChar(const cc: TASCIIControlCharacter);
var
c: char;
begin
{$ifdef hasgtk2term}
c := Char(cc);
if assigned(fTerminalHanlde) and assigned(vte_terminal_feed_child) then
vte_terminal_feed_child(fTerminalHanlde, @c, 1);
{$endif}
end;
procedure TTerminal.copyToClipboard();
begin
{$ifdef hasgtk2term}
@ -319,6 +346,30 @@ begin
{$endif}
end;
{$ifdef hasgtk2term}
function clbckTrueSel(terminal: PVteTerminal; column: glong; row: glong; data: Pointer): gboolean; cdecl;
begin
result := True;
end;
{$endif}
function TTerminal.getLine(const line: integer): string;
{$ifdef hasgtk2term}
var
c: glong;
a: PGArray = nil;
{$endif}
begin
result := '';
{$ifdef hasgtk2term}
if assigned(fTerminalHanlde) and assigned(vte_terminal_get_text_range) then
begin
c := vte_terminal_get_column_count(fTerminalHanlde);
result := vte_terminal_get_text_range(fTerminalHanlde, line, 0, line, c, @clbckTrueSel, nil, a);
end;
{$endif}
end;
function TerminalAvailable: Boolean;
begin
{$ifdef hasgtk2term}
@ -371,6 +422,25 @@ procedure TTerminal.Paint;
begin
end;
function TTerminal.getCursorPosition: TPoint;
{$ifdef hasgtk2term}
var
col: glong = 0;
row: glong = 0;
{$endif}
begin
{$ifdef hasgtk2term}
result.x:=0;
result.y:=0;
if assigned(fTerminalHanlde) and assigned(vte_terminal_get_cursor_position) then
begin
vte_terminal_get_cursor_position(fTerminalHanlde, @col, @row);
result.x:= col;
result.y:= row;
end;
{$endif}
end;
procedure TTerminal.setScrollBackLines(value: LongWord);
{$ifdef hasgtk2term}
var

View File

@ -76,8 +76,9 @@ type
private
fTerm: TTerminal;
fOpts: TTerminalOptions;
fLastCd: string;
fLastCheckedDirectory: string;
fNeedApplyChanges: boolean;
procedure checkDirectory(const dir: string);
procedure docNew(document: TDexedMemo);
procedure docFocused(document: TDexedMemo);
@ -277,6 +278,16 @@ begin
fNeedApplyChanges := true;
end;
procedure TTermWidget.checkDirectory(const dir: string);
begin
fLastCheckedDirectory := dir;
fTerm.SendControlChar(TASCIIControlCharacter.HOME);
fTerm.SendControlChar(TASCIIControlCharacter.VT);
fNeedApplyChanges := true;
fOpts.applyChanges;
fTerm.Command('cd ' + dir);
end;
procedure TTermWidget.SetVisible(Value: boolean);
begin
inherited;
@ -313,14 +324,8 @@ end;
procedure TTermWidget.mnexDirectoryChanged(const directory: string);
begin
if fOpts.followExplorer and directory.dirExists and
not SameText(directory, fLastCd) then
begin
fLastCd := directory;
fTerm.Restart;
fNeedApplyChanges := true;
fOpts.applyChanges;
fTerm.Command('cd ' + directory);
end;
not SameText(directory, fLastCheckedDirectory) then
checkDirectory(directory);
end;
procedure TTermWidget.docNew(document: TDexedMemo);
@ -332,14 +337,8 @@ var
s: string;
begin
s := document.fileName.extractFileDir;
if fOpts.followEditors and s.fileExists and not SameText(s, fLastCd) then
begin
fLastCd := s;
fTerm.Restart;
fNeedApplyChanges := true;
fOpts.applyChanges;
fTerm.Command('cd ' + s);
end;
if fOpts.followProjects and s.dirExists and not SameText(s, fLastCheckedDirectory) then
checkDirectory(s);
end;
procedure TTermWidget.docChanged(document: TDexedMemo);
@ -367,14 +366,8 @@ var
s: string;
begin
s := project.fileName.extractFileDir;
if fOpts.followProjects and s.dirExists and not SameText(s, fLastCd) then
begin
fLastCd := s;
fTerm.Restart;
fNeedApplyChanges := true;
fOpts.applyChanges;
fTerm.Command('cd ' + s);
end;
if fOpts.followProjects and s.dirExists and not SameText(s, fLastCheckedDirectory) then
checkDirectory(s);
end;
procedure TTermWidget.projCompiling(project: ICommonProject);