mirror of https://gitlab.com/basile.b/dexed.git
start the terminal widget
This commit is contained in:
Basile Burg
parent
d0ef3a9130
commit
12f61e02e7
|
|
@ -0,0 +1,130 @@
|
|||
unit Gtk2Term;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
{$ifdef lclgtk2}
|
||||
{$ifdef unix}
|
||||
{$define hasgtk2term}
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
{$ifdef hasgtk2term}
|
||||
|
||||
uses
|
||||
GLib2, Gtk2, dynlibs, gdk2, pango;
|
||||
|
||||
type
|
||||
GPid = LongWord;
|
||||
PGPid = ^GPid;
|
||||
GError = LongWord;
|
||||
PGError = ^GError;
|
||||
|
||||
TVtePtyFlags = LongWord;
|
||||
|
||||
const
|
||||
VTE_PTY_DEFAULT = $0;
|
||||
VTE_PTY_NO_LASTLOG = $1;
|
||||
VTE_PTY_NO_UTMP = $2;
|
||||
VTE_PTY_NO_WTMP = $4;
|
||||
VTE_PTY_NO_HELPER = $8;
|
||||
VTE_PTY_NO_FALLBACK = $10;
|
||||
|
||||
type
|
||||
TGSpawnFlags = LongWord;
|
||||
|
||||
const
|
||||
G_SPAWN_DEFAULT = $0;
|
||||
G_SPAWN_LEAVE_DESCRIPTORS_OPEN = $1;
|
||||
G_SPAWN_DO_NOT_REAP_CHILD = $2;
|
||||
G_SPAWN_SEARCH_PATH = $4;
|
||||
G_SPAWN_STDOUT_TO_DEV_NULL = $8;
|
||||
G_SPAWN_STDERR_TO_DEV_NULL = $10;
|
||||
G_SPAWN_CHILD_INHERITS_STDIN = $20;
|
||||
G_SPAWN_FILE_AND_ARGV_ZERO = $40;
|
||||
G_SPAWN_SEARCH_PATH_FROM_ENVP = $80;
|
||||
G_SPAWN_CLOEXEC_PIPES = $100;
|
||||
|
||||
type
|
||||
TGSpawnChildSetupFunc = procedure(user_data: Pointer); cdecl;
|
||||
|
||||
PVteTerminal = ^TVteTerminal;
|
||||
TVteTerminal = record
|
||||
widget: PGtkWidget;
|
||||
end;
|
||||
|
||||
VTE_TERMINAL = PVteTerminal;
|
||||
|
||||
var
|
||||
vte_terminal_new: function: PGtkWidget; cdecl;
|
||||
|
||||
vte_terminal_fork_command_full: function(terminal: PVteTerminal; pty_flags: TVtePtyFlags;
|
||||
working_directory: PChar; argv, envv: PPChar; spawn_flags: TGSpawnFlags;
|
||||
child_setup: TGSpawnChildSetupFunc; child_setup_data: Pointer; child_pid:
|
||||
PGPid; error: PGError): GBoolean; cdecl;
|
||||
|
||||
vte_terminal_set_color_background: procedure(terminal: PVteTerminal;
|
||||
const background: PGdkColor); cdecl;
|
||||
|
||||
vte_terminal_set_color_foreground: procedure(terminal: PVteTerminal;
|
||||
const background: PGdkColor); cdecl;
|
||||
|
||||
vte_terminal_set_color_highlight: procedure(terminal: PVteTerminal;
|
||||
const background: PGdkColor); cdecl;
|
||||
|
||||
vte_terminal_set_color_highlight_foreground: procedure(terminal: PVteTerminal;
|
||||
const background: PGdkColor); cdecl;
|
||||
|
||||
vte_terminal_set_font: procedure(terminal: PVteTerminal;
|
||||
const font_desc: PPangoFontDescription); cdecl;
|
||||
|
||||
vte_terminal_feed: procedure(terminal: PVteTerminal; data: PChar;
|
||||
length: PtrInt); cdecl;
|
||||
|
||||
vte_terminal_feed_child: procedure(terminal: PVteTerminal; data: PChar; length: PtrInt); cdecl;
|
||||
|
||||
vte_get_user_shell: function(): PChar;
|
||||
|
||||
function Gtk2TermLoad: Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
Initialized: Boolean;
|
||||
Loaded: Boolean;
|
||||
|
||||
function Gtk2TermLoad: Boolean;
|
||||
const
|
||||
vte = 'libvte.so';
|
||||
var
|
||||
Lib: TLibHandle;
|
||||
begin
|
||||
if Initialized then
|
||||
Exit(Loaded);
|
||||
Initialized := True;
|
||||
Lib := LoadLibrary(vte);
|
||||
if Lib = 0 then
|
||||
Exit(Loaded);
|
||||
|
||||
@vte_terminal_new := GetProcAddress(Lib, 'vte_terminal_new');
|
||||
@vte_terminal_fork_command_full := GetProcAddress(Lib, 'vte_terminal_fork_command_full');
|
||||
@vte_terminal_set_color_background := GetProcAddress(Lib, 'vte_terminal_set_color_background');
|
||||
@vte_terminal_set_color_foreground := GetProcAddress(Lib, 'vte_terminal_set_color_foreground');
|
||||
@vte_terminal_set_color_highlight := GetProcAddress(Lib, 'vte_terminal_set_color_highlight');
|
||||
@vte_terminal_set_color_highlight_foreground := GetProcAddress(Lib, 'vte_terminal_set_color_highlight_foreground');
|
||||
@vte_terminal_set_font := GetProcAddress(Lib, 'vte_terminal_set_font');
|
||||
@vte_terminal_feed := GetProcAddress(Lib, 'vte_terminal_feed');
|
||||
@vte_terminal_feed_child := GetProcAddress(Lib, 'vte_terminal_feed_child');
|
||||
@vte_get_user_shell := GetProcAddress(Lib, 'vte_get_user_shell');
|
||||
|
||||
// assume all or none
|
||||
Loaded := @vte_terminal_new <> nil;
|
||||
|
||||
Result := Loaded;
|
||||
end;
|
||||
{$else}
|
||||
implementation
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
|
|
@ -0,0 +1,352 @@
|
|||
unit TerminalCtrls;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
{$ifdef lclgtk2}
|
||||
{$ifdef unix}
|
||||
{$define hasgtk2term}
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Gtk2Term, Classes, SysUtils, Controls, Graphics;
|
||||
|
||||
type
|
||||
|
||||
TTerminal = class(TCustomControl)
|
||||
private
|
||||
FInfo: Pointer;
|
||||
fTerminalHanlde: PVteTerminal;
|
||||
fOnTerminate: TNotifyEvent;
|
||||
fOnTerminalVisibleChanged: TNotifyEvent;
|
||||
fBackgroundColor: TColor;
|
||||
fForegroundColor: TColor;
|
||||
fSelectedColor: TColor;
|
||||
procedure setBackgroundColor(value: TColor);
|
||||
procedure setForegroundColor(value: TColor);
|
||||
procedure setSelectedColor(value: TColor);
|
||||
protected
|
||||
// Only used at design-time.
|
||||
procedure Paint; override;
|
||||
procedure DoTerminate; virtual;
|
||||
procedure DoTerminalVisibleChanged; virtual;
|
||||
procedure FontChanged(Sender: TObject); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure Restart;
|
||||
// Sends a command, as it would be manually typed. Line feed is automatically added.
|
||||
procedure Command(const data: string);
|
||||
published
|
||||
// Background color
|
||||
property backgroundColor: TColor read fBackgroundColor write setBackgroundColor default clBlack;
|
||||
// Font color
|
||||
property foregroundColor: TColor read fForegroundColor write setForegroundColor default clWhite;
|
||||
// Background color for the selection
|
||||
property selectedColor: TColor read fSelectedColor write setSelectedColor default clWhite;
|
||||
property Align;
|
||||
property Anchors;
|
||||
property Constraints;
|
||||
property DockSite;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
property DragMode;
|
||||
property DoubleBuffered;
|
||||
property Enabled;
|
||||
// The name and height properties are handled. see foregroundColor for Color.
|
||||
property Font;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property UseDockManager default True;
|
||||
property Visible;
|
||||
property OnClick;
|
||||
property OnContextPopup;
|
||||
property OnDockDrop;
|
||||
property OnDockOver;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDock;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnGetSiteInfo;
|
||||
property OnGetDockCaption;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseWheelDown;
|
||||
property OnMouseWheelUp;
|
||||
property OnResize;
|
||||
property OnStartDock;
|
||||
property OnStartDrag;
|
||||
property OnUnDock;
|
||||
property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
|
||||
// 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;
|
||||
end;
|
||||
|
||||
function TerminalAvailable: Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
{$ifdef hasgtk2term}
|
||||
uses
|
||||
LCLType, WSControls, WSLCLClasses, GLib2, Gtk2, Gtk2Def, Gtk2Proc,
|
||||
Gtk2WSControls, gdk2;
|
||||
|
||||
type
|
||||
|
||||
TGtk2WSTerminal = class(TWSCustomControl)
|
||||
protected
|
||||
class procedure SetCallbacks(const AGtkWidget: PGtkWidget;
|
||||
const AWidgetInfo: PWidgetInfo); virtual;
|
||||
published
|
||||
class function CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): TLCLIntfHandle; override;
|
||||
end;
|
||||
|
||||
procedure TerminalExit(Widget: PGtkWidget); cdecl;
|
||||
var
|
||||
Info: PWidgetInfo;
|
||||
begin
|
||||
Info := PWidgetInfo(g_object_get_data(PGObject(Widget), 'widgetinfo'));
|
||||
TTerminal(Info.LCLObject).DoTerminate;
|
||||
end;
|
||||
|
||||
procedure TerminalRefresh(Widget: PGtkWidget); cdecl;
|
||||
var
|
||||
Info: PWidgetInfo;
|
||||
begin
|
||||
Info := PWidgetInfo(g_object_get_data(PGObject(Widget), 'widgetinfo'));
|
||||
TTerminal(Info.LCLObject).DoTerminalVisibleChanged;
|
||||
end;
|
||||
|
||||
class procedure TGtk2WSTerminal.SetCallbacks(const AGtkWidget: PGtkWidget;
|
||||
const AWidgetInfo: PWidgetInfo);
|
||||
begin
|
||||
TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
|
||||
end;
|
||||
|
||||
class function TGtk2WSTerminal.CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): TLCLIntfHandle;
|
||||
var
|
||||
Info: PWidgetInfo;
|
||||
Style: PGtkRCStyle;
|
||||
Args: array[0..1] of PChar = (nil, nil);
|
||||
Allocation: TGTKAllocation;
|
||||
const
|
||||
Flgs: array[boolean] of integer = (GTK_CAN_FOCUS, GTK_CAN_FOCUS or GTK_DOUBLE_BUFFERED);
|
||||
begin
|
||||
Args[0] := vte_get_user_shell();
|
||||
if Args[0] = nil then
|
||||
Args[0] := '/bin/bash';
|
||||
|
||||
{ Initialize widget info }
|
||||
Info := CreateWidgetInfo(gtk_frame_new(nil), AWinControl, AParams);
|
||||
Info.LCLObject := AWinControl;
|
||||
Info.Style := AParams.Style;
|
||||
Info.ExStyle := AParams.ExStyle;
|
||||
Info.WndProc := {%H-}PtrUInt(AParams.WindowClass.lpfnWndProc);
|
||||
TTerminal(AWinControl).FInfo := Info;
|
||||
|
||||
{ Configure core and client }
|
||||
gtk_frame_set_shadow_type(PGtkFrame(Info.CoreWidget), GTK_SHADOW_NONE);
|
||||
Style := gtk_widget_get_modifier_style(Info.CoreWidget);
|
||||
Style.xthickness := 0;
|
||||
Style.ythickness := 0;
|
||||
gtk_widget_modify_style(Info.CoreWidget, Style);
|
||||
if csDesigning in AWinControl.ComponentState then
|
||||
Info.ClientWidget := CreateFixedClientWidget(True)
|
||||
else
|
||||
begin
|
||||
Info.ClientWidget := vte_terminal_new();
|
||||
TTerminal(AWinControl).fTerminalHanlde := VTE_TERMINAL(Info.ClientWidget);
|
||||
vte_terminal_fork_command_full(VTE_TERMINAL(Info.ClientWidget), VTE_PTY_DEFAULT,
|
||||
nil, @Args[0], nil, G_SPAWN_SEARCH_PATH, nil, nil, nil, nil);
|
||||
end;
|
||||
GTK_WIDGET_SET_FLAGS(Info.CoreWidget, Flgs[AWinControl.DoubleBuffered]);
|
||||
gtk_container_add(GTK_CONTAINER(Info.CoreWidget), Info.ClientWidget);
|
||||
g_object_set_data(PGObject(Info.ClientWidget), 'widgetinfo', Info);
|
||||
gtk_widget_show_all(Info.CoreWidget);
|
||||
Allocation.X := AParams.X;
|
||||
Allocation.Y := AParams.Y;
|
||||
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);
|
||||
SetCallbacks(Info.CoreWidget, Info);
|
||||
Result := {%H-}TLCLIntfHandle(Info.CoreWidget);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
procedure TTerminal.DoTerminate;
|
||||
begin
|
||||
if Assigned(FOnTerminate) then
|
||||
FOnTerminate(Self);
|
||||
end;
|
||||
|
||||
procedure TTerminal.DoTerminalVisibleChanged;
|
||||
begin
|
||||
if Assigned(fOnTerminalVisibleChanged) then
|
||||
fOnTerminalVisibleChanged(Self);
|
||||
end;
|
||||
|
||||
procedure TTerminal.Restart;
|
||||
{$ifdef hasgtk2term}
|
||||
var
|
||||
Info: PWidgetInfo;
|
||||
Args: array[0..1] of PChar = (nil, nil);
|
||||
{$endif}
|
||||
begin
|
||||
{$ifdef hasgtk2term}
|
||||
if not HandleAllocated then
|
||||
Exit;
|
||||
|
||||
Args[0] := vte_get_user_shell();
|
||||
if Args[0] = nil then
|
||||
Args[0] := '/bin/bash';
|
||||
Info := PWidgetInfo(FInfo);
|
||||
gtk_widget_destroy(Info.ClientWidget);
|
||||
Info.ClientWidget := vte_terminal_new;
|
||||
fTerminalHanlde := VTE_TERMINAL(Info.ClientWidget);
|
||||
vte_terminal_fork_command_full(fTerminalHanlde, VTE_PTY_DEFAULT,
|
||||
nil, @Args[0], nil, G_SPAWN_SEARCH_PATH, nil, nil, nil, nil);
|
||||
gtk_container_add(GTK_CONTAINER(Info.CoreWidget), Info.ClientWidget);
|
||||
g_object_set_data(PGObject(Info.ClientWidget), 'widgetinfo', Info);
|
||||
gtk_widget_show_all(Info.CoreWidget);
|
||||
g_signal_connect(Info.ClientWidget, 'child-exited', G_CALLBACK(@TerminalExit), nil);
|
||||
g_signal_connect(Info.ClientWidget, 'contents-changed', G_CALLBACK(@TerminalRefresh), nil);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TTerminal.Command(const data: string);
|
||||
begin
|
||||
{$ifdef hasgtk2term}
|
||||
if assigned(fTerminalHanlde) and assigned(vte_terminal_feed_child) then
|
||||
vte_terminal_feed_child(fTerminalHanlde, PChar(data + #10), data.Length + 1);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function TerminalAvailable: Boolean;
|
||||
begin
|
||||
{$ifdef hasgtk2term}
|
||||
Result := Gtk2TermLoad;
|
||||
{$else}
|
||||
Result := false;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function RegisterTerminal: Boolean;
|
||||
begin
|
||||
Result := TerminalAvailable;
|
||||
if Result then
|
||||
RegisterWSComponent(TTerminal, TGtk2WSTerminal);
|
||||
end;
|
||||
|
||||
constructor TTerminal.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Width := 300;
|
||||
Height := 200;
|
||||
fBackgroundColor:= clBlack;
|
||||
fForegroundColor:= clWhite;
|
||||
fSelectedColor:= clWhite;
|
||||
Font.Height:=11;
|
||||
Font.Name:='Monospace';
|
||||
end;
|
||||
|
||||
procedure TTerminal.Paint;
|
||||
const
|
||||
s = 'linux@user:~$ bash terminal';
|
||||
var
|
||||
w: integer = 0;
|
||||
h: integer = 0;
|
||||
begin
|
||||
if not (csDesigning in ComponentState) then
|
||||
exit;
|
||||
|
||||
Canvas.Pen.Style := psDash;
|
||||
Canvas.Pen.Color := clWhite;
|
||||
Canvas.Brush.Color := clBlack;
|
||||
Canvas.Font.Color := clWhite;
|
||||
Canvas.FillRect(ClientRect);
|
||||
Canvas.Rectangle(ClientRect);
|
||||
Canvas.GetTextSize(s, w, h);
|
||||
Canvas.TextOut((Width - w) div 2, (Height - h) div 2, s);
|
||||
end;
|
||||
|
||||
procedure TTerminal.setBackgroundColor(value: TColor);
|
||||
var
|
||||
c: TGDKColor;
|
||||
begin
|
||||
fBackgroundColor:=value;
|
||||
{$ifdef hasgtk2term}
|
||||
if assigned(fTerminalHanlde) and assigned(vte_terminal_set_color_background) then
|
||||
begin
|
||||
c := TColortoTGDKColor(fBackgroundColor);
|
||||
vte_terminal_set_color_background(fTerminalHanlde, @c);
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TTerminal.setForegroundColor(value: TColor);
|
||||
var
|
||||
c: TGDKColor;
|
||||
begin
|
||||
fForegroundColor:=value;
|
||||
{$ifdef hasgtk2term}
|
||||
if assigned(fTerminalHanlde) and assigned(vte_terminal_set_color_foreground) then
|
||||
begin
|
||||
c := TColortoTGDKColor(fForegroundColor);
|
||||
vte_terminal_set_color_foreground(fTerminalHanlde, @c);
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TTerminal.setSelectedColor(value: TColor);
|
||||
var
|
||||
c: TGDKColor;
|
||||
begin
|
||||
fSelectedColor:=value;
|
||||
{$ifdef hasgtk2term}
|
||||
if assigned(fTerminalHanlde) and assigned(vte_terminal_set_color_highlight)
|
||||
and assigned(vte_terminal_set_color_highlight_foreground) then
|
||||
begin
|
||||
c := TColortoTGDKColor(fSelectedColor);
|
||||
vte_terminal_set_color_highlight(fTerminalHanlde, @c);
|
||||
c := TColortoTGDKColor(InvertColor(fSelectedColor));
|
||||
vte_terminal_set_color_highlight_foreground(fTerminalHanlde, @c);
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TTerminal.FontChanged(Sender: TObject);
|
||||
begin
|
||||
inherited;
|
||||
{$ifdef hasgtk2term}
|
||||
{$push}{$Hints off}
|
||||
if assigned(fTerminalHanlde) and assigned(vte_terminal_set_font) and
|
||||
(Handle <> INVALID_HANDLE_VALUE) then
|
||||
begin
|
||||
vte_terminal_set_font(fTerminalHanlde, PGtkWidget(Handle).style.font_desc);
|
||||
end;
|
||||
{$pop}
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{$ifdef hasgtk2term}
|
||||
initialization
|
||||
RegisterTerminal;
|
||||
{$endif}
|
||||
end.
|
||||
|
||||
|
|
@ -403,7 +403,7 @@
|
|||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\src;..\etc\fcl-json\src"/>
|
||||
<OtherUnitFiles Value="..\src;..\etc\terminal"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
|
|
@ -433,10 +433,6 @@
|
|||
<IgnoredMessages idx5024="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-dDEBUG"/>
|
||||
<OtherDefines Count="2">
|
||||
<Define0 Value="RELEASE"/>
|
||||
<Define1 Value="GTK_REMOVE_CLIPBOARD_NULL"/>
|
||||
</OtherDefines>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item2>
|
||||
|
|
@ -449,7 +445,7 @@
|
|||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\src;..\etc\fcl-json\src"/>
|
||||
<OtherUnitFiles Value="..\src;..\etc\terminal"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
|
|
@ -519,7 +515,7 @@
|
|||
<PackageName Value="LCL"/>
|
||||
</Item8>
|
||||
</RequiredPackages>
|
||||
<Units Count="59">
|
||||
<Units Count="60">
|
||||
<Unit0>
|
||||
<Filename Value="coedit.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
|
|
@ -826,6 +822,13 @@
|
|||
<Filename Value="..\src\ce_semver.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit58>
|
||||
<Unit59>
|
||||
<Filename Value="..\src\ce_term.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="CETermWidget"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit59>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
|
@ -836,7 +839,7 @@
|
|||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\src"/>
|
||||
<OtherUnitFiles Value="..\src;..\etc\terminal"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ uses
|
|||
ce_processes, ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt,
|
||||
ce_lcldragdrop, ce_stringrange, ce_dlangmaps, ce_projgroup, ce_projutils,
|
||||
ce_d2synpresets, ce_dastworx, ce_dbgitf, ce_ddemangle, ce_dubproject,
|
||||
ce_halstead, ce_diff, ce_profileviewer, ce_semver;
|
||||
ce_halstead, ce_diff, ce_profileviewer, ce_semver, ce_term;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ uses
|
|||
ce_toolseditor, ce_procinput, ce_optionseditor, ce_symlist, ce_mru, ce_processes,
|
||||
ce_infos, ce_dubproject, ce_dialogs, ce_dubprojeditor,{$IFDEF UNIX} ce_gdb,{$ENDIF}
|
||||
ce_dfmt, ce_lcldragdrop, ce_projgroup, ce_projutils, ce_stringrange, ce_dastworx,
|
||||
ce_halstead, ce_profileviewer, ce_semver, ce_dsgncontrols;
|
||||
ce_halstead, ce_profileviewer, ce_semver, ce_dsgncontrols, ce_term;
|
||||
|
||||
type
|
||||
|
||||
|
|
@ -384,6 +384,7 @@ type
|
|||
fPrjGrpWidg: TCEProjectGroupWidget;
|
||||
{$IFDEF UNIX}
|
||||
fGdbWidg: TCEGdbWidget;
|
||||
fTermWWidg: TCETermWidget;
|
||||
{$ENDIF}
|
||||
fDfmtWidg: TCEDfmtWidget;
|
||||
fProfWidg: TCEProfileViewerWidget;
|
||||
|
|
@ -1464,6 +1465,7 @@ begin
|
|||
fProfWidg := TCEProfileViewerWidget.create(self);
|
||||
{$IFDEF UNIX}
|
||||
fGdbWidg := TCEGdbWidget.create(self);
|
||||
fTermWWidg := TCETermWidget.create(self);
|
||||
{$ENDIF}
|
||||
|
||||
getMessageDisplay(fMsgs);
|
||||
|
|
@ -1487,6 +1489,7 @@ begin
|
|||
fWidgList.addWidget(@fProfWidg);
|
||||
{$IFDEF UNIX}
|
||||
fWidgList.addWidget(@fGdbWidg);
|
||||
fWidgList.addWidget(@fTermWWidg);
|
||||
{$ENDIF}
|
||||
|
||||
fWidgList.sort(@CompareWidgCaption);
|
||||
|
|
|
|||
|
|
@ -0,0 +1,9 @@
|
|||
inherited CETermWidget: TCETermWidget
|
||||
Caption = 'Terminal'
|
||||
inherited Back: TPanel
|
||||
inherited Content: TPanel
|
||||
Height = 85
|
||||
Top = 36
|
||||
end
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,258 @@
|
|||
unit ce_term;
|
||||
|
||||
{$I ce_defines.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
|
||||
ce_widget, TerminalCtrls, ce_interfaces, ce_writableComponent, ce_observer,
|
||||
ce_common, ce_synmemo;
|
||||
|
||||
type
|
||||
|
||||
// Terminal options
|
||||
TCETerminalOptionsBase = class(TWritableLfmTextComponent)
|
||||
private
|
||||
fBackgroundColor: TColor;
|
||||
fForegroundColor: TColor;
|
||||
fSelectedColor: TColor;
|
||||
fFollowEditors: boolean;
|
||||
fFollowProjects: boolean;
|
||||
fFont: TFont;
|
||||
procedure setFont(value: TFont);
|
||||
public
|
||||
constructor create(AOwner: TComponent); override;
|
||||
destructor destroy; override;
|
||||
procedure assign(value: TPersistent); override;
|
||||
published
|
||||
property backgroundColor: TColor read fBackgroundColor write fBackgroundColor;
|
||||
property foregroundColor: TColor read fForegroundColor write fForegroundColor;
|
||||
property selectedColor: TColor read fSelectedColor write fSelectedColor;
|
||||
property font: TFont read fFont write setFont;
|
||||
property followEditors: boolean read fFollowEditors write fFollowEditors;
|
||||
property followProjects: boolean read fFollowProjects write fFollowProjects;
|
||||
end;
|
||||
|
||||
// Editable and reversible Terminal options
|
||||
TCETerminalOptions = class(TCETerminalOptionsBase, ICEEditableOptions)
|
||||
private
|
||||
fBackup: TCETerminalOptionsBase;
|
||||
function optionedWantCategory(): string;
|
||||
function optionedWantEditorKind: TOptionEditorKind;
|
||||
function optionedWantContainer: TPersistent;
|
||||
procedure optionedEvent(event: TOptionEditorEvent);
|
||||
function optionedOptionsModified: boolean;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure applyChanges;
|
||||
end;
|
||||
|
||||
{ TCETermWidget }
|
||||
|
||||
TCETermWidget = class(TCEWidget, ICEDocumentObserver, ICEProjectObserver)
|
||||
procedure FormShow(Sender: TObject);
|
||||
private
|
||||
fTerm: TTerminal;
|
||||
fOpts: TCETerminalOptions;
|
||||
|
||||
procedure docNew(document: TCESynMemo);
|
||||
procedure docFocused(document: TCESynMemo);
|
||||
procedure docChanged(document: TCESynMemo);
|
||||
procedure docClosing(document: TCESynMemo);
|
||||
|
||||
procedure projNew(project: ICECommonProject);
|
||||
procedure projChanged(project: ICECommonProject);
|
||||
procedure projClosing(project: ICECommonProject);
|
||||
procedure projFocused(project: ICECommonProject);
|
||||
procedure projCompiling(project: ICECommonProject);
|
||||
procedure projCompiled(project: ICECommonProject; success: boolean);
|
||||
|
||||
public
|
||||
constructor create(aOwner: TComponent); override;
|
||||
destructor destroy; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
{$R *.lfm}
|
||||
|
||||
const
|
||||
optFname = 'terminal.txt';
|
||||
|
||||
constructor TCETerminalOptionsBase.create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fFont := TFont.Create;
|
||||
fBackgroundColor:= clWhite;
|
||||
fForegroundColor:= clBlack;
|
||||
fSelectedColor:= clBlack;
|
||||
fFont.Name:= 'Monospace';
|
||||
fFont.Size:= 12;
|
||||
end;
|
||||
|
||||
destructor TCETerminalOptionsBase.destroy;
|
||||
begin
|
||||
fFont.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCETerminalOptionsBase.setFont(value: TFont);
|
||||
begin
|
||||
fFont.Assign(value);
|
||||
end;
|
||||
|
||||
procedure TCETerminalOptionsBase.assign(value: TPersistent);
|
||||
var
|
||||
s: TCETerminalOptionsBase;
|
||||
begin
|
||||
if value is TCETerminalOptionsBase then
|
||||
begin
|
||||
s := TCETerminalOptionsBase(value);
|
||||
fBackgroundColor:=s.fbackgroundColor;
|
||||
fForegroundColor:=s.fForegroundColor;
|
||||
fSelectedColor:=s.fSelectedColor;
|
||||
followEditors:=s.fFollowEditors;
|
||||
fFont.Assign(s.font);
|
||||
end
|
||||
else inherited;
|
||||
end;
|
||||
|
||||
constructor TCETerminalOptions.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fBackup := TCETerminalOptionsBase.Create(self);
|
||||
end;
|
||||
|
||||
procedure TCETerminalOptions.applyChanges;
|
||||
var
|
||||
w: TCETermWidget;
|
||||
begin
|
||||
w := TCETermWidget(owner);
|
||||
w.fTerm.backgroundColor:= backgroundColor;
|
||||
w.fTerm.foregroundColor:= foregroundColor;
|
||||
w.fTerm.selectedColor:= selectedColor;
|
||||
w.fTerm.Font.BeginUpdate;
|
||||
w.fTerm.Font.Assign(fFont);
|
||||
w.fTerm.Font.Size := w.fTerm.Font.Size +1;
|
||||
w.fTerm.Font.Size := w.fTerm.Font.Size -1;
|
||||
w.fTerm.Font.endUpdate;
|
||||
end;
|
||||
|
||||
function TCETerminalOptions.optionedWantCategory(): string;
|
||||
begin
|
||||
result := 'Terminal';
|
||||
end;
|
||||
|
||||
function TCETerminalOptions.optionedWantEditorKind: TOptionEditorKind;
|
||||
begin
|
||||
result := oekGeneric;
|
||||
end;
|
||||
|
||||
function TCETerminalOptions.optionedWantContainer: TPersistent;
|
||||
begin
|
||||
result := self;
|
||||
end;
|
||||
|
||||
procedure TCETerminalOptions.optionedEvent(event: TOptionEditorEvent);
|
||||
begin
|
||||
case event of
|
||||
oeeAccept:
|
||||
begin
|
||||
fBackup.assign(self);
|
||||
applyChanges;
|
||||
end;
|
||||
oeeCancel:
|
||||
begin
|
||||
self.assign(fBackup);
|
||||
applyChanges;
|
||||
end;
|
||||
oeeChange:
|
||||
begin
|
||||
applyChanges;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCETerminalOptions.optionedOptionsModified: boolean;
|
||||
begin
|
||||
result := false;
|
||||
end;
|
||||
|
||||
constructor TCETermWidget.create(aOwner: TComponent);
|
||||
var
|
||||
f: string;
|
||||
begin
|
||||
inherited;
|
||||
fTerm := TTerminal.Create(self);
|
||||
fTerm.Align:= alClient;
|
||||
fTerm.BorderSpacing.Around:=4;
|
||||
fterm.Parent := self;
|
||||
fTerm.OnTerminalVisibleChanged:=@FormShow;
|
||||
|
||||
fOpts:= TCETerminalOptions.Create(self);
|
||||
|
||||
f := getCoeditDocPath + optFname;
|
||||
if f.fileExists then
|
||||
fOpts.loadFromFile(f);
|
||||
|
||||
EntitiesConnector.addObserver(fOpts);
|
||||
end;
|
||||
|
||||
destructor TCETermWidget.destroy;
|
||||
begin
|
||||
fOpts.saveToFile(getCoeditDocPath + optFname);
|
||||
EntitiesConnector.removeObserver(fOpts);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.FormShow(Sender: TObject);
|
||||
begin
|
||||
fOpts.applyChanges;
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.docNew(document: TCESynMemo);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.docFocused(document: TCESynMemo);
|
||||
begin
|
||||
if fOpts.followEditors and document.fileName.fileExists then
|
||||
fTerm.Command('cd ' + document.fileName.extractFileDir);
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.docChanged(document: TCESynMemo);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.docClosing(document: TCESynMemo);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.projNew(project: ICECommonProject);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.projChanged(project: ICECommonProject);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.projClosing(project: ICECommonProject);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.projFocused(project: ICECommonProject);
|
||||
begin
|
||||
if fOpts.followProjects and project.fileName.fileExists then
|
||||
fTerm.Command('cd ' + project.fileName.extractFileDir);
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.projCompiling(project: ICECommonProject);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TCETermWidget.projCompiled(project: ICECommonProject; success: boolean);
|
||||
begin
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue