├── .gitignore ├── terminal.bmp ├── terminal_icons.res ├── images └── screenshot.png ├── vteintf.pas ├── terminal.inc ├── README.md ├── terminal.pas ├── terminalemulatordlg.lfm ├── terminaldgsn.pas ├── terminalregister.pas ├── terminal.lpk ├── terminaldgsn.lpk ├── terminalemulatordlg.pas ├── novte.pas ├── vte.pas ├── gtk3vte.pas ├── LICENSE.md ├── terminalctrls.pas └── gtk2vte.pas /.gitignore: -------------------------------------------------------------------------------- 1 | backup 2 | lib 3 | 4 | -------------------------------------------------------------------------------- /terminal.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sysrpl/Lazarus.Terminal/HEAD/terminal.bmp -------------------------------------------------------------------------------- /terminal_icons.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sysrpl/Lazarus.Terminal/HEAD/terminal_icons.res -------------------------------------------------------------------------------- /images/screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sysrpl/Lazarus.Terminal/HEAD/images/screenshot.png -------------------------------------------------------------------------------- /vteintf.pas: -------------------------------------------------------------------------------- 1 | unit VteIntf; 2 | 3 | {$i terminal.inc} 4 | 5 | interface 6 | 7 | implementation 8 | 9 | end. 10 | 11 | -------------------------------------------------------------------------------- /terminal.inc: -------------------------------------------------------------------------------- 1 | {$mode delphi} 2 | {$define nosupport} 3 | {$ifdef linux} 4 | {$ifdef lclgtk2} 5 | {$undef nosupport} 6 | {$define terminalgtk2} 7 | {$endif} 8 | {$ifdef lclgtk3} 9 | {$undef nosupport} 10 | {$define terminalgtk3} 11 | {$endif} 12 | {$endif} 13 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Lazarus Terminal 2 | 3 | ![alt screenshot](images/screenshot.png) 4 | 5 | This package adds gnome terminal component and plugin to the Lazarus IDE. It requires the gtk2 widgetset and the vte Linux package. 6 | 7 | ```bash 8 | sudo apt install libvte9 9 | ``` 10 | 11 | To the terminal inside the IDE install the design time package and select Terminal from the View menu. 12 | 13 | ## Recent changes 14 | 15 | * Added custom colors 16 | * Added custom fonts 17 | -------------------------------------------------------------------------------- /terminal.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit terminal; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | TerminalCtrls, Vte, VteIntf, LazarusPackageIntf; 12 | 13 | implementation 14 | 15 | procedure Register; 16 | begin 17 | end; 18 | 19 | initialization 20 | RegisterPackage('terminal', @Register); 21 | end. 22 | -------------------------------------------------------------------------------- /terminalemulatordlg.lfm: -------------------------------------------------------------------------------- 1 | object TerminalEmulatorDlg: TTerminalEmulatorDlg 2 | Left = 1040 3 | Height = 240 4 | Top = 250 5 | Width = 320 6 | Caption = 'Terminal' 7 | ClientHeight = 240 8 | ClientWidth = 320 9 | LCLVersion = '1.9.0.0' 10 | object Terminal: TTerminal 11 | Left = 0 12 | Height = 240 13 | Top = 0 14 | Width = 320 15 | Align = alClient 16 | TabOrder = 0 17 | UseDockManager = False 18 | OnTerminate = TerminalTerminate 19 | end 20 | end 21 | -------------------------------------------------------------------------------- /terminaldgsn.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit terminaldgsn; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | TerminalRegister, TerminalEmulatorDlg, LazarusPackageIntf; 12 | 13 | implementation 14 | 15 | procedure Register; 16 | begin 17 | RegisterUnit('TerminalRegister', @TerminalRegister.Register); 18 | end; 19 | 20 | initialization 21 | RegisterPackage('terminaldgsn', @Register); 22 | end. 23 | -------------------------------------------------------------------------------- /terminalregister.pas: -------------------------------------------------------------------------------- 1 | unit TerminalRegister; 2 | 3 | {$mode delphi} 4 | 5 | interface 6 | 7 | uses 8 | Classes, LazIDEIntf, ProjectIntf, MenuIntf, TerminalCtrls, TerminalEmulatorDlg; 9 | 10 | procedure Register; 11 | 12 | implementation 13 | 14 | {$R terminal_icons.res} 15 | 16 | procedure Register; 17 | begin 18 | {$ifdef lclgtk2} 19 | RegisterComponents('Additional', [TTerminal]); 20 | RegisterIDEMenuCommand(itmViewSecondaryWindows, 'TerminalEmulatorItem', 'Terminal', 21 | nil, ShowTerminalEmulatorDialog, nil, 'menu_information'); 22 | InitTerminalEmulatorDialog; 23 | {$endif} 24 | end; 25 | 26 | end. 27 | -------------------------------------------------------------------------------- /terminal.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /terminaldgsn.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /terminalemulatordlg.pas: -------------------------------------------------------------------------------- 1 | unit TerminalEmulatorDlg; 2 | 3 | {$mode delphi} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, TerminalCtrls; 9 | 10 | { TTerminalEmulatorDlg } 11 | 12 | type 13 | TTerminalEmulatorDlg = class(TForm) 14 | Terminal: TTerminal; 15 | procedure TerminalTerminate(Sender: TObject); 16 | end; 17 | 18 | procedure InitTerminalEmulatorDialog; 19 | procedure ShowTerminalEmulatorDialog(Sender: TObject); 20 | 21 | implementation 22 | 23 | {$R *.lfm} 24 | 25 | uses 26 | IDEWindowIntf, LazIDEIntf; 27 | 28 | { TTerminalEmulatorDlg } 29 | 30 | procedure TTerminalEmulatorDlg.TerminalTerminate(Sender: TObject); 31 | begin 32 | Terminal.Restart; 33 | end; 34 | 35 | var 36 | TerminalEmulatorWindowCreator: TIDEWindowCreator; 37 | TerminalEmulatorDlg: TTerminalEmulatorDlg; 38 | 39 | procedure CreateTerminalEmulator(Sender: TObject; {%H-}aFormName: string; var AForm: TCustomForm; DoDisableAutoSizing: Boolean); 40 | begin 41 | if TerminalEmulatorDlg = nil then 42 | IDEWindowCreators.CreateForm(TerminalEmulatorDlg, TTerminalEmulatorDlg, 43 | DoDisableAutoSizing, LazarusIDE.OwningComponent); 44 | AForm := TerminalEmulatorDlg; 45 | end; 46 | 47 | procedure InitTerminalEmulatorDialog; 48 | begin 49 | if TerminalEmulatorDlg = nil then 50 | begin 51 | TerminalEmulatorWindowCreator := IDEWindowCreators.Add('TerminalEmulatorDlg'); 52 | TerminalEmulatorWindowCreator.OnCreateFormProc := CreateTerminalEmulator; 53 | TerminalEmulatorWindowCreator.CreateSimpleLayout; 54 | end; 55 | end; 56 | 57 | procedure ShowTerminalEmulatorDialog(Sender: TObject); 58 | begin 59 | IDEWindowCreators.ShowForm('TerminalEmulatorDlg', True); 60 | end; 61 | 62 | end. 63 | 64 | -------------------------------------------------------------------------------- /novte.pas: -------------------------------------------------------------------------------- 1 | unit NoVte; 2 | 3 | {$i terminal.inc} 4 | 5 | interface 6 | 7 | {$ifdef nosupport} 8 | uses 9 | SysUtils, Classes, Graphics, Controls, LCLType, WSControls, WSLCLClasses; 10 | 11 | function TerminalLoad: Boolean; 12 | function NewTerminal(Control: TTerminalControl): ITerminal; 13 | 14 | type 15 | TWSTerminalControl = class(TWSCustomControl) 16 | published 17 | class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; 18 | end; 19 | {$endif} 20 | 21 | implementation 22 | 23 | {$ifdef nosupport} 24 | uses 25 | VteIntf; 26 | 27 | type 28 | TTerminal = class(TInterfacedObject, ITerminal) 29 | private 30 | FControl: TTerminalControl; 31 | protected 32 | procedure SetInfo(Value: Pointer); 33 | procedure SetColor(Element: TTerminalElement; Value: TColor); 34 | procedure SetFont(Value: TFont); 35 | procedure Paint; 36 | procedure Restart; 37 | public 38 | constructor Create(Control: TTerminalControl); 39 | end; 40 | 41 | constructor TTerminal.Create(Control: TTerminalControl); 42 | begin 43 | inherited Create; 44 | FControl := Control; 45 | end; 46 | 47 | procedure TTerminal.SetInfo(Value: Pointer); 48 | begin 49 | end; 50 | 51 | procedure TTerminal.SetColor(Element: TTerminalElement; Value: TColor); 52 | begin 53 | end; 54 | 55 | procedure TTerminal.SetFont(Value: TFont); 56 | begin 57 | end; 58 | 59 | procedure TTerminal.Paint; 60 | const 61 | S = 'user@linux~$ bash terminal unsupported'; 62 | var 63 | Canvas: TCanvas; 64 | W, H: Integer; 65 | begin 66 | Canvas := FControl.Canvas; 67 | Canvas.Brush.Style := bsSolid; 68 | Canvas.FillRect(FControl.ClientRect); 69 | W := 0; H := 0; 70 | Canvas.GetTextSize(S, W, H); 71 | Canvas.Font.Color := Canvas.Pen.Color; 72 | Canvas.TextOut((FControl.Width - W) div 2, (FControl.Height - H) div 2, S); 73 | Canvas.Pen.Style := psDash; 74 | Canvas.Pen.Color := clWhite; 75 | Canvas.Brush.Style := bsClear; 76 | Canvas.Rectangle(FControl.ClientRect); 77 | end; 78 | 79 | procedure TTerminal.Restart; 80 | begin 81 | end; 82 | 83 | function TerminalLoad: Boolean; 84 | begin 85 | Result := False; 86 | end; 87 | 88 | function NewTerminal(Control: TTerminalControl): ITerminal; 89 | begin 90 | Result := TTerminal.Create(Control); 91 | end; 92 | 93 | 94 | class function TWSTerminalControl.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; 95 | begin 96 | Result := 0; 97 | end; 98 | {$endif} 99 | 100 | end. 101 | 102 | -------------------------------------------------------------------------------- /vte.pas: -------------------------------------------------------------------------------- 1 | unit Vte; 2 | 3 | {$mode delphi} 4 | 5 | interface 6 | 7 | type 8 | guint8 = Byte; 9 | guint16 = Word; 10 | guint32 = LongWord; 11 | 12 | GPid = LongWord; 13 | PGPid = ^GPid; 14 | GError = LongWord; 15 | PGError = ^GError; 16 | PGtkWidget = Pointer; 17 | GBoolean = LongBool; 18 | 19 | PGdkColor = Pointer; 20 | PPangoFontDescription = Pointer; 21 | 22 | TVtePtyFlags = LongWord; 23 | 24 | const 25 | VTE_PTY_DEFAULT = $0; 26 | VTE_PTY_NO_LASTLOG = $1; 27 | VTE_PTY_NO_UTMP = $2; 28 | VTE_PTY_NO_WTMP = $4; 29 | VTE_PTY_NO_HELPER = $8; 30 | VTE_PTY_NO_FALLBACK = $10; 31 | 32 | type 33 | TGSpawnFlags = LongWord; 34 | 35 | const 36 | G_SPAWN_DEFAULT = $0; 37 | G_SPAWN_LEAVE_DESCRIPTORS_OPEN = $1; 38 | G_SPAWN_DO_NOT_REAP_CHILD = $2; 39 | G_SPAWN_SEARCH_PATH = $4; 40 | G_SPAWN_STDOUT_TO_DEV_NULL = $8; 41 | G_SPAWN_STDERR_TO_DEV_NULL = $10; 42 | G_SPAWN_CHILD_INHERITS_STDIN = $20; 43 | G_SPAWN_FILE_AND_ARGV_ZERO = $40; 44 | G_SPAWN_SEARCH_PATH_FROM_ENVP = $80; 45 | G_SPAWN_CLOEXEC_PIPES = $100; 46 | 47 | type 48 | TGSpawnChildSetupFunc = procedure(user_data: Pointer); cdecl; 49 | 50 | PVteTerminal = ^TVteTerminal; 51 | TVteTerminal = record 52 | end; 53 | 54 | VTE_TERMINAL = PVteTerminal; 55 | 56 | var 57 | vte_terminal_new: function: PGtkWidget; cdecl; 58 | vte_terminal_fork_command_full: function(terminal: PVteTerminal; pty_flags: TVtePtyFlags; 59 | working_directory: PChar; argv, envv: PPChar; spawn_flags: TGSpawnFlags; 60 | child_setup: TGSpawnChildSetupFunc; child_setup_data: Pointer; child_pid: 61 | PGPid; error: PGError): GBoolean; cdecl; 62 | vte_terminal_set_allow_bold: procedure(terminal: PVteTerminal; allow_bold: GBoolean); cdecl; 63 | vte_terminal_set_font: procedure(terminal: PVteTerminal; font_desc: PPangoFontDescription); cdecl; 64 | vte_terminal_set_color_foreground: procedure(terminal: PVteTerminal; foreground: PGdkColor); cdecl; 65 | vte_terminal_set_color_background: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 66 | vte_terminal_set_color_bold: procedure(terminal: PVteTerminal; foreground: PGdkColor); cdecl; 67 | vte_terminal_set_color_dim: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 68 | vte_terminal_set_color_cursor: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 69 | vte_terminal_set_color_highlight: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 70 | 71 | function TerminalLoad: Boolean; 72 | 73 | implementation 74 | 75 | var 76 | Initialized: Boolean; 77 | Loaded: Boolean; 78 | 79 | function TerminalLoad: Boolean; 80 | const 81 | vte = 'libvte.so.9'; 82 | var 83 | Lib: TLibHandle; 84 | 85 | function Load(const ProcName : string; out Proc: Pointer): Boolean; 86 | begin 87 | Proc := GetProcAddress(Lib, ProcName); 88 | Result := Proc <> nil; 89 | end; 90 | 91 | begin 92 | if Initialized then 93 | Exit(Loaded); 94 | Initialized := True; 95 | Lib := LoadLibrary(vte); 96 | if Lib = 0 then 97 | Exit(Loaded); 98 | Loaded := 99 | Load('vte_terminal_new', @vte_terminal_new) and 100 | Load('vte_terminal_fork_command_full', @vte_terminal_fork_command_full) and 101 | Load('vte_terminal_set_allow_bold', @vte_terminal_set_allow_bold) and 102 | Load('vte_terminal_set_font', @vte_terminal_set_font) and 103 | Load('vte_terminal_set_color_foreground', @vte_terminal_set_color_foreground) and 104 | Load('vte_terminal_set_color_background', @vte_terminal_set_color_background) and 105 | Load('vte_terminal_set_color_bold', @vte_terminal_set_color_bold) and 106 | Load('vte_terminal_set_color_dim', @vte_terminal_set_color_dim) and 107 | Load('vte_terminal_set_color_cursor', @vte_terminal_set_color_cursor) and 108 | Load('vte_terminal_set_color_highlight', @vte_terminal_set_color_highlight); 109 | Result := Loaded; 110 | end; 111 | 112 | end. 113 | -------------------------------------------------------------------------------- /gtk3vte.pas: -------------------------------------------------------------------------------- 1 | unit Gtk3Vte; 2 | 3 | {$i terminal.inc} 4 | 5 | interface 6 | 7 | {$ifdef linux} 8 | uses 9 | SysUtils, Classes, Graphics, Controls, LCLType, WSControls, WSLCLClasses, 10 | TerminalCtrls; 11 | 12 | function TerminalLoad: Boolean; 13 | function NewTerminal(Control: TTerminalControl): ITerminal; 14 | 15 | type 16 | TWSTerminalControl = class(TWSCustomControl) 17 | published 18 | class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; 19 | end; 20 | {$endif} 21 | 22 | implementation 23 | 24 | {$ifdef linux} 25 | 26 | uses 27 | // Pango, 28 | LazGtk3, LazGdk3, LazGObject2, LazGLib2, LazCairo1, LazPango1, LazGdkPixbuf2, 29 | Gtk3objects, Gtk3procs, Gtk3WSControls, Gtk3Widgets; 30 | 31 | type 32 | guint8 = Byte; 33 | guint16 = Word; 34 | guint32 = LongWord; 35 | 36 | GPid = LongWord; 37 | PGPid = ^GPid; 38 | GError = LongWord; 39 | PGError = ^GError; 40 | GCancellable = Pointer; 41 | PGCancellable = ^GCancellable; 42 | PGtkWidget = Pointer; 43 | GBoolean = LongBool; 44 | 45 | PGdkColor = Pointer; 46 | PPangoFontDescription = Pointer; 47 | 48 | TVtePtyFlags = LongWord; 49 | 50 | const 51 | VTE_PTY_DEFAULT = $0; 52 | VTE_PTY_NO_LASTLOG = $1; 53 | VTE_PTY_NO_UTMP = $2; 54 | VTE_PTY_NO_WTMP = $4; 55 | VTE_PTY_NO_HELPER = $8; 56 | VTE_PTY_NO_FALLBACK = $10; 57 | 58 | type 59 | TGSpawnFlags = LongWord; 60 | 61 | const 62 | G_SPAWN_DEFAULT = $0; 63 | G_SPAWN_LEAVE_DESCRIPTORS_OPEN = $1; 64 | G_SPAWN_DO_NOT_REAP_CHILD = $2; 65 | G_SPAWN_SEARCH_PATH = $4; 66 | G_SPAWN_STDOUT_TO_DEV_NULL = $8; 67 | G_SPAWN_STDERR_TO_DEV_NULL = $10; 68 | G_SPAWN_CHILD_INHERITS_STDIN = $20; 69 | G_SPAWN_FILE_AND_ARGV_ZERO = $40; 70 | G_SPAWN_SEARCH_PATH_FROM_ENVP = $80; 71 | G_SPAWN_CLOEXEC_PIPES = $100; 72 | 73 | type 74 | TGSpawnChildSetupFunc = procedure(user_data: Pointer); cdecl; 75 | 76 | PVteTerminal = ^TVteTerminal; 77 | TVteTerminal = record 78 | end; 79 | 80 | VTE_TERMINAL = PVteTerminal; 81 | 82 | var 83 | vte_terminal_new: function: PGtkWidget; cdecl; 84 | vte_terminal_spawn_sync: function(terminal: PVteTerminal; pty_flags: TVtePtyFlags; 85 | working_directory: PChar; argv, envv: PPChar; spawn_flags: TGSpawnFlags; 86 | child_setup: TGSpawnChildSetupFunc; child_setup_data: Pointer; child_pid: 87 | PGPid; cancellable: PGCancellable; error: PGError): GBoolean; cdecl; 88 | vte_terminal_set_allow_bold: procedure(terminal: PVteTerminal; allow_bold: GBoolean); cdecl; 89 | vte_terminal_set_font: procedure(terminal: PVteTerminal; font_desc: PPangoFontDescription); cdecl; 90 | vte_terminal_set_color_foreground: procedure(terminal: PVteTerminal; foreground: PGdkColor); cdecl; 91 | vte_terminal_set_color_background: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 92 | vte_terminal_set_color_bold: procedure(terminal: PVteTerminal; foreground: PGdkColor); cdecl; 93 | vte_terminal_set_color_cursor: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 94 | vte_terminal_set_color_highlight: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 95 | 96 | var 97 | Initialized: Boolean; 98 | Loaded: Boolean; 99 | 100 | function TerminalLoad: Boolean; 101 | const 102 | vte = 'libvte-2.91.so.0'; 103 | var 104 | Lib: TLibHandle; 105 | 106 | function Load(const ProcName : string; out Proc: Pointer): Boolean; 107 | begin 108 | Proc := GetProcAddress(Lib, ProcName); 109 | Result := Proc <> nil; 110 | end; 111 | 112 | begin 113 | if Initialized then 114 | Exit(Loaded); 115 | Initialized := True; 116 | Lib := LoadLibrary(vte); 117 | if Lib = 0 then 118 | Exit(Loaded); 119 | Loaded := 120 | Load('vte_terminal_new', @vte_terminal_new) and 121 | Load('vte_terminal_spawn_sync', @vte_terminal_spawn_sync) and 122 | Load('vte_terminal_set_allow_bold', @vte_terminal_set_allow_bold) and 123 | Load('vte_terminal_set_font', @vte_terminal_set_font) and 124 | Load('vte_terminal_set_color_foreground', @vte_terminal_set_color_foreground) and 125 | Load('vte_terminal_set_color_background', @vte_terminal_set_color_background) and 126 | Load('vte_terminal_set_color_bold', @vte_terminal_set_color_bold) and 127 | Load('vte_terminal_set_color_cursor', @vte_terminal_set_color_cursor) and 128 | Load('vte_terminal_set_color_highlight', @vte_terminal_set_color_highlight); 129 | Loaded := False; 130 | Result := Loaded; 131 | end; 132 | 133 | type 134 | TTerminalHack = class(TTerminalControl) 135 | end; 136 | 137 | procedure TerminalReady(Widget: PGtkWidget); cdecl; 138 | begin 139 | end; 140 | 141 | procedure TerminalExit(Widget: PGtkWidget); cdecl; 142 | begin 143 | end; 144 | 145 | type 146 | TGtk3Terminal = class(TGtk3Widget) 147 | private 148 | FTerminal: PVteTerminal; 149 | public 150 | constructor Create(const AWinControl: TWinControl; 151 | const AParams: TCreateParams); override; 152 | procedure DoReady; 153 | procedure DoExit; 154 | property Terminal: PVteTerminal read FTerminal write FTerminal; 155 | end; 156 | 157 | // g_signal_connect_data(FWidget, 'destroy', TGCallback(@TGtk3Widget.destroy_event), Self, nil, 0); 158 | 159 | constructor TGtk3Terminal.Create(const AWinControl: TWinControl; 160 | const AParams: TCreateParams); 161 | var 162 | Frame: PGtkFrame; 163 | Teminal: PVteTerminal; 164 | begin 165 | inherited Create(AWinControl, AParams); 166 | Frame := gtk_frame_new(nil); 167 | gtk_frame_set_shadow_type(Frame, GTK_SHADOW_NONE); 168 | if 169 | 170 | Self.Widget := Frame; 171 | 172 | g_signal_connect_data(); 173 | // g_signal_connect_data(FWidget, 'destroy', TGCallback(@TGtk3Widget.destroy_event), Self, nil, 0); 174 | 175 | end; 176 | 177 | 178 | procedure TGtk3Terminal.DoReady; 179 | begin 180 | end; 181 | 182 | procedure TGtk3Terminal.DoExit; 183 | begin 184 | end; 185 | 186 | 187 | type 188 | TTerminal = class(TInterfacedObject, ITerminal) 189 | private 190 | FControl: TTerminalControl; 191 | protected 192 | procedure SetInfo(Value: Pointer); 193 | procedure SetColor(Element: TTerminalElement; Value: TColor); 194 | procedure SetFont(Value: TFont); 195 | procedure Paint; 196 | procedure Restart; 197 | public 198 | constructor Create(Control: TTerminalControl); 199 | end; 200 | 201 | constructor TTerminal.Create(Control: TTerminalControl); 202 | begin 203 | inherited Create; 204 | FControl := Control; 205 | end; 206 | 207 | procedure TTerminal.SetInfo(Value: Pointer); 208 | begin 209 | end; 210 | 211 | procedure TTerminal.SetColor(Element: TTerminalElement; Value: TColor); 212 | begin 213 | end; 214 | 215 | procedure TTerminal.SetFont(Value: TFont); 216 | begin 217 | end; 218 | 219 | procedure TTerminal.Paint; 220 | const 221 | S = 'user@linux~$ bash terminal Gtk3'; 222 | var 223 | Canvas: TCanvas; 224 | W, H: Integer; 225 | begin 226 | Canvas := FControl.Canvas; 227 | Canvas.Brush.Style := bsSolid; 228 | Canvas.FillRect(FControl.ClientRect); 229 | W := 0; H := 0; 230 | Canvas.GetTextSize(S, W, H); 231 | Canvas.Font.Color := Canvas.Pen.Color; 232 | Canvas.TextOut((FControl.Width - W) div 2, (FControl.Height - H) div 2, S); 233 | Canvas.Pen.Style := psDash; 234 | Canvas.Pen.Color := clWhite; 235 | Canvas.Brush.Style := bsClear; 236 | Canvas.Rectangle(FControl.ClientRect); 237 | end; 238 | 239 | procedure TTerminal.Restart; 240 | begin 241 | end; 242 | 243 | function NewTerminal(Control: TTerminalControl): ITerminal; 244 | begin 245 | Result := TTerminal.Create(Control); 246 | end; 247 | 248 | { TWSTerminalControl } 249 | 250 | class function TWSTerminalControl.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; 251 | var 252 | T: TGtk3Terminal; 253 | begin 254 | T := TGtk3Terminal.Create(AWinControl, AParams); 255 | T.Widget := ; 256 | Result := 0; 257 | end; 258 | {$endif} 259 | 260 | end. 261 | 262 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | GNU Lesser General Public License 2 | ================================= 3 | 4 | _Version 3, 29 June 2007_ 5 | _Copyright © 2007 Free Software Foundation, Inc. <>_ 6 | 7 | Everyone is permitted to copy and distribute verbatim copies 8 | of this license document, but changing it is not allowed. 9 | 10 | 11 | This version of the GNU Lesser General Public License incorporates 12 | the terms and conditions of version 3 of the GNU General Public 13 | License, supplemented by the additional permissions listed below. 14 | 15 | ### 0. Additional Definitions 16 | 17 | As used herein, “this License” refers to version 3 of the GNU Lesser 18 | General Public License, and the “GNU GPL” refers to version 3 of the GNU 19 | General Public License. 20 | 21 | “The Library” refers to a covered work governed by this License, 22 | other than an Application or a Combined Work as defined below. 23 | 24 | An “Application” is any work that makes use of an interface provided 25 | by the Library, but which is not otherwise based on the Library. 26 | Defining a subclass of a class defined by the Library is deemed a mode 27 | of using an interface provided by the Library. 28 | 29 | A “Combined Work” is a work produced by combining or linking an 30 | Application with the Library. The particular version of the Library 31 | with which the Combined Work was made is also called the “Linked 32 | Version”. 33 | 34 | The “Minimal Corresponding Source” for a Combined Work means the 35 | Corresponding Source for the Combined Work, excluding any source code 36 | for portions of the Combined Work that, considered in isolation, are 37 | based on the Application, and not on the Linked Version. 38 | 39 | The “Corresponding Application Code” for a Combined Work means the 40 | object code and/or source code for the Application, including any data 41 | and utility programs needed for reproducing the Combined Work from the 42 | Application, but excluding the System Libraries of the Combined Work. 43 | 44 | ### 1. Exception to Section 3 of the GNU GPL 45 | 46 | You may convey a covered work under sections 3 and 4 of this License 47 | without being bound by section 3 of the GNU GPL. 48 | 49 | ### 2. Conveying Modified Versions 50 | 51 | If you modify a copy of the Library, and, in your modifications, a 52 | facility refers to a function or data to be supplied by an Application 53 | that uses the facility (other than as an argument passed when the 54 | facility is invoked), then you may convey a copy of the modified 55 | version: 56 | 57 | * **a)** under this License, provided that you make a good faith effort to 58 | ensure that, in the event an Application does not supply the 59 | function or data, the facility still operates, and performs 60 | whatever part of its purpose remains meaningful, or 61 | 62 | * **b)** under the GNU GPL, with none of the additional permissions of 63 | this License applicable to that copy. 64 | 65 | ### 3. Object Code Incorporating Material from Library Header Files 66 | 67 | The object code form of an Application may incorporate material from 68 | a header file that is part of the Library. You may convey such object 69 | code under terms of your choice, provided that, if the incorporated 70 | material is not limited to numerical parameters, data structure 71 | layouts and accessors, or small macros, inline functions and templates 72 | (ten or fewer lines in length), you do both of the following: 73 | 74 | * **a)** Give prominent notice with each copy of the object code that the 75 | Library is used in it and that the Library and its use are 76 | covered by this License. 77 | * **b)** Accompany the object code with a copy of the GNU GPL and this license 78 | document. 79 | 80 | ### 4. Combined Works 81 | 82 | You may convey a Combined Work under terms of your choice that, 83 | taken together, effectively do not restrict modification of the 84 | portions of the Library contained in the Combined Work and reverse 85 | engineering for debugging such modifications, if you also do each of 86 | the following: 87 | 88 | * **a)** Give prominent notice with each copy of the Combined Work that 89 | the Library is used in it and that the Library and its use are 90 | covered by this License. 91 | 92 | * **b)** Accompany the Combined Work with a copy of the GNU GPL and this license 93 | document. 94 | 95 | * **c)** For a Combined Work that displays copyright notices during 96 | execution, include the copyright notice for the Library among 97 | these notices, as well as a reference directing the user to the 98 | copies of the GNU GPL and this license document. 99 | 100 | * **d)** Do one of the following: 101 | - **0)** Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | - **1)** Use a suitable shared library mechanism for linking with the 109 | Library. A suitable mechanism is one that **(a)** uses at run time 110 | a copy of the Library already present on the user's computer 111 | system, and **(b)** will operate properly with a modified version 112 | of the Library that is interface-compatible with the Linked 113 | Version. 114 | 115 | * **e)** Provide Installation Information, but only if you would otherwise 116 | be required to provide such information under section 6 of the 117 | GNU GPL, and only to the extent that such information is 118 | necessary to install and execute a modified version of the 119 | Combined Work produced by recombining or relinking the 120 | Application with a modified version of the Linked Version. (If 121 | you use option **4d0**, the Installation Information must accompany 122 | the Minimal Corresponding Source and Corresponding Application 123 | Code. If you use option **4d1**, you must provide the Installation 124 | Information in the manner specified by section 6 of the GNU GPL 125 | for conveying Corresponding Source.) 126 | 127 | ### 5. Combined Libraries 128 | 129 | You may place library facilities that are a work based on the 130 | Library side by side in a single library together with other library 131 | facilities that are not Applications and are not covered by this 132 | License, and convey such a combined library under terms of your 133 | choice, if you do both of the following: 134 | 135 | * **a)** Accompany the combined library with a copy of the same work based 136 | on the Library, uncombined with any other library facilities, 137 | conveyed under the terms of this License. 138 | * **b)** Give prominent notice with the combined library that part of it 139 | is a work based on the Library, and explaining where to find the 140 | accompanying uncombined form of the same work. 141 | 142 | ### 6. Revised Versions of the GNU Lesser General Public License 143 | 144 | The Free Software Foundation may publish revised and/or new versions 145 | of the GNU Lesser General Public License from time to time. Such new 146 | versions will be similar in spirit to the present version, but may 147 | differ in detail to address new problems or concerns. 148 | 149 | Each version is given a distinguishing version number. If the 150 | Library as you received it specifies that a certain numbered version 151 | of the GNU Lesser General Public License “or any later version” 152 | applies to it, you have the option of following the terms and 153 | conditions either of that published version or of any later version 154 | published by the Free Software Foundation. If the Library as you 155 | received it does not specify a version number of the GNU Lesser 156 | General Public License, you may choose any version of the GNU Lesser 157 | General Public License ever published by the Free Software Foundation. 158 | 159 | If the Library as you received it specifies that a proxy can decide 160 | whether future versions of the GNU Lesser General Public License shall 161 | apply, that proxy's public statement of acceptance of any version is 162 | permanent authorization for you to choose that version for the 163 | Library. 164 | -------------------------------------------------------------------------------- /terminalctrls.pas: -------------------------------------------------------------------------------- 1 | unit TerminalCtrls; 2 | 3 | {$i terminal.inc} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Controls, Graphics, LCLIntf; 9 | 10 | { ITerminal } 11 | 12 | type 13 | TTerminalElement = (teFore, teBack, teBold, teDim, teCursor, teHighlight); 14 | 15 | ITerminal = interface 16 | ['{9A2FEC91-5C43-494C-B6FC-C47742E85316}'] 17 | procedure SetInfo(Value: Pointer); 18 | procedure SetColor(Element: TTerminalElement; Value: TColor); 19 | procedure SetFont(Value: TFont); 20 | procedure Paint; 21 | procedure Restart; 22 | end; 23 | 24 | { TTerminalColors } 25 | 26 | TTerminalColors = class(TPersistent) 27 | private 28 | FTerminal: ITerminal; 29 | FColors: array[TTerminalElement] of TColor; 30 | FChanged: TNotifyEvent; 31 | procedure SetColor(Index: Integer; Value: TColor); 32 | function GetColor(Index: Integer): TColor; 33 | public 34 | constructor Create(Terminal: ITerminal; Changed: TNotifyEvent); 35 | procedure Assign(Source: TPersistent); override; 36 | procedure Restart; 37 | published 38 | property Foreground: TColor index 0 read GetColor write SetColor default clSilver; 39 | property Background: TColor index 1 read GetColor write SetColor default clBlack; 40 | property Bold: TColor index 2 read GetColor write SetColor default clWhite; 41 | property Dim: TColor index 3 read GetColor write SetColor default clGray; 42 | property Cursor: TColor index 4 read GetColor write SetColor default clWhite; 43 | property Highlight: TColor index 5 read GetColor write SetColor default clWhite; 44 | end; 45 | 46 | { TTerminalControl } 47 | 48 | TTerminalControl = class(TCustomControl) 49 | protected 50 | FTerminal: ITerminal; 51 | protected 52 | class procedure WSRegisterClass; override; 53 | procedure DoReady; virtual; 54 | procedure DoTerminate; virtual; 55 | property Terminal: ITerminal read FTerminal; 56 | public 57 | constructor Create(AOwner: TComponent); override; 58 | end; 59 | 60 | { TCustomTerminal } 61 | 62 | TCustomTerminal = class(TTerminalControl) 63 | private 64 | FColors: TTerminalColors; 65 | FOnReady: TNotifyEvent; 66 | FOnTerminate: TNotifyEvent; 67 | procedure SetColors(Value: TTerminalColors); 68 | protected 69 | procedure DoReady; override; 70 | procedure DoTerminate; override; 71 | procedure ColorsChanged(Sender: TObject); 72 | procedure FontChanged(Sender: TObject); override; 73 | procedure Paint; override; 74 | property Colors: TTerminalColors read FColors write SetColors; 75 | property OnReady: TNotifyEvent read FOnReady write FOnReady; 76 | property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate; 77 | public 78 | constructor Create(AOwner: TComponent); override; 79 | procedure Restart; 80 | end; 81 | 82 | { TTerminal } 83 | 84 | TTerminal = class(TCustomTerminal) 85 | published 86 | property Align; 87 | property Anchors; 88 | property Colors; 89 | property Constraints; 90 | property DockSite; 91 | property DragCursor; 92 | property DragKind; 93 | property DragMode; 94 | property Enabled; 95 | property Font; 96 | property ParentShowHint; 97 | property PopupMenu; 98 | property ShowHint; 99 | property TabOrder; 100 | property TabStop; 101 | property UseDockManager default True; 102 | property Visible; 103 | property OnClick; 104 | property OnContextPopup; 105 | property OnDockDrop; 106 | property OnDockOver; 107 | property OnDblClick; 108 | property OnDragDrop; 109 | property OnDragOver; 110 | property OnEndDock; 111 | property OnEndDrag; 112 | property OnEnter; 113 | property OnExit; 114 | property OnGetSiteInfo; 115 | property OnGetDockCaption; 116 | property OnMouseDown; 117 | property OnMouseEnter; 118 | property OnMouseLeave; 119 | property OnMouseMove; 120 | property OnMouseUp; 121 | property OnMouseWheel; 122 | property OnMouseWheelDown; 123 | property OnMouseWheelUp; 124 | property OnReady; 125 | property OnResize; 126 | property OnStartDock; 127 | property OnStartDrag; 128 | property OnUnDock; 129 | property OnTerminate; 130 | end; 131 | 132 | function TerminalAvailable: Boolean; 133 | 134 | implementation 135 | 136 | uses 137 | LCLType, WSLCLClasses, 138 | {$ifdef terminalgtk2} 139 | Gtk2Vte; 140 | {$endif} 141 | {$ifdef terminalgtk3} 142 | Gtk3Vte; 143 | {$endif} 144 | {$ifdef nosupport} 145 | NoVte; 146 | {$endif} 147 | 148 | function TerminalAvailable: Boolean; 149 | begin 150 | Result := TerminalLoad; 151 | end; 152 | 153 | { TTerminalColors } 154 | 155 | constructor TTerminalColors.Create(Terminal: ITerminal; Changed: TNotifyEvent); 156 | begin 157 | inherited Create; 158 | FTerminal := Terminal; 159 | FColors[teFore] := clSilver; 160 | FColors[teBack] := clBlack; 161 | FColors[teBold] := clWhite; 162 | FColors[teDim] := clGray; 163 | FColors[teCursor] := clWhite; 164 | FColors[teHighlight] := clWhite; 165 | FChanged := Changed; 166 | end; 167 | 168 | procedure TTerminalColors.Assign(Source: TPersistent); 169 | var 170 | C: TTerminalColors; 171 | E: TTerminalElement; 172 | begin 173 | if Source = Self then 174 | Exit; 175 | if Source is TTerminalColors then 176 | begin 177 | C := Source as TTerminalColors; 178 | for E := Low(FColors) to High(FColors) do 179 | FColors[E] := C.FColors[E]; 180 | Restart; 181 | FChanged(Self); 182 | end 183 | else 184 | inherited Assign(Source); 185 | end; 186 | 187 | procedure TTerminalColors.Restart; 188 | var 189 | E: TTerminalElement; 190 | begin 191 | for E := Low(FColors) to High(FColors) do 192 | FTerminal.SetColor(E, FColors[E]); 193 | end; 194 | 195 | procedure TTerminalColors.SetColor(Index: Integer; Value: TColor); 196 | var 197 | E: TTerminalElement; 198 | begin 199 | E := TTerminalElement(Index); 200 | if Value <> FColors[E] then 201 | begin 202 | FColors[E] := Value; 203 | FTerminal.SetColor(E, FColors[E]); 204 | FChanged(Self); 205 | end; 206 | end; 207 | 208 | function TTerminalColors.GetColor(Index: Integer): TColor; 209 | var 210 | E: TTerminalElement; 211 | begin 212 | E := TTerminalElement(Index); 213 | Result := FColors[E]; 214 | end; 215 | 216 | { TTerminalControl } 217 | 218 | var 219 | Registered: Boolean; 220 | 221 | class procedure TTerminalControl.WSRegisterClass; 222 | begin 223 | if Registered then 224 | Exit; 225 | Registered := True; 226 | if TerminalAvaiable then 227 | RegisterWSComponent(TTerminalControl, TWSTerminalControl); 228 | end; 229 | 230 | constructor TTerminalControl.Create(AOwner: TComponent); 231 | begin 232 | inherited Create(AOwner); 233 | FTerminal := NewTerminal(Self); 234 | end; 235 | 236 | procedure TTerminalControl.DoReady; 237 | begin 238 | end; 239 | 240 | procedure TTerminalControl.DoTerminate; 241 | begin 242 | end; 243 | 244 | { TCustomTerminal } 245 | 246 | constructor TCustomTerminal.Create(AOwner: TComponent); 247 | begin 248 | inherited Create(AOwner); 249 | FColors := TTerminalColors.Create(Terminal, ColorsChanged); 250 | Width := 300; 251 | Height := 200; 252 | ParentFont := False; 253 | Font.Name := 'Monospace'; 254 | end; 255 | 256 | procedure TCustomTerminal.DoReady; 257 | begin 258 | FColors.Restart; 259 | Terminal.SetFont(Font); 260 | if Assigned(FOnReady) then 261 | FOnReady(Self); 262 | end; 263 | 264 | procedure TCustomTerminal.DoTerminate; 265 | begin 266 | if Assigned(FOnTerminate) then 267 | FOnTerminate(Self); 268 | end; 269 | 270 | procedure TCustomTerminal.SetColors(Value: TTerminalColors); 271 | begin 272 | FColors.Assign(Value); 273 | end; 274 | 275 | procedure TCustomTerminal.ColorsChanged(Sender: TObject); 276 | begin 277 | if csDesigning in ComponentState then 278 | Invalidate; 279 | end; 280 | 281 | procedure TCustomTerminal.FontChanged(Sender: TObject); 282 | begin 283 | inherited FontChanged(Sender); 284 | Terminal.SetFont(Font); 285 | if csDesigning in ComponentState then 286 | Invalidate; 287 | end; 288 | 289 | procedure TCustomTerminal.Paint; 290 | begin 291 | Canvas.Brush.Color := FColors.Background; 292 | Canvas.Pen.Color := FColors.Foreground; 293 | Canvas.Font.Assign(Font); 294 | Terminal.Paint; 295 | end; 296 | 297 | procedure TCustomTerminal.Restart; 298 | begin 299 | Terminal.Restart; 300 | end; 301 | 302 | end. 303 | 304 | -------------------------------------------------------------------------------- /gtk2vte.pas: -------------------------------------------------------------------------------- 1 | unit Gtk2Vte; 2 | 3 | {$i terminal.inc} 4 | 5 | interface 6 | 7 | {$ifdef terminalgtk2} 8 | uses 9 | SysUtils, Classes, Graphics, Controls, LCLType, WSControls, WSLCLClasses, 10 | TerminalCtrls; 11 | 12 | function TerminalLoad: Boolean; 13 | function NewTerminal(Control: TTerminalControl): ITerminal; 14 | 15 | type 16 | TWSTerminalControl = class(TWSCustomControl) 17 | published 18 | class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; 19 | end; 20 | {$endif} 21 | 22 | implementation 23 | 24 | {$ifdef terminalgtk2} 25 | uses 26 | GLib2, Gtk2, Gtk2Def, Gtk2Proc, Pango, Gtk2WSControls; 27 | 28 | type 29 | guint8 = Byte; 30 | guint16 = Word; 31 | guint32 = LongWord; 32 | 33 | GPid = LongWord; 34 | PGPid = ^GPid; 35 | GError = LongWord; 36 | PGError = ^GError; 37 | PGtkWidget = Pointer; 38 | GBoolean = LongBool; 39 | 40 | PGdkColor = Pointer; 41 | PPangoFontDescription = Pointer; 42 | 43 | TVtePtyFlags = LongWord; 44 | 45 | const 46 | VTE_PTY_DEFAULT = $0; 47 | VTE_PTY_NO_LASTLOG = $1; 48 | VTE_PTY_NO_UTMP = $2; 49 | VTE_PTY_NO_WTMP = $4; 50 | VTE_PTY_NO_HELPER = $8; 51 | VTE_PTY_NO_FALLBACK = $10; 52 | 53 | type 54 | TGSpawnFlags = LongWord; 55 | 56 | const 57 | G_SPAWN_DEFAULT = $0; 58 | G_SPAWN_LEAVE_DESCRIPTORS_OPEN = $1; 59 | G_SPAWN_DO_NOT_REAP_CHILD = $2; 60 | G_SPAWN_SEARCH_PATH = $4; 61 | G_SPAWN_STDOUT_TO_DEV_NULL = $8; 62 | G_SPAWN_STDERR_TO_DEV_NULL = $10; 63 | G_SPAWN_CHILD_INHERITS_STDIN = $20; 64 | G_SPAWN_FILE_AND_ARGV_ZERO = $40; 65 | G_SPAWN_SEARCH_PATH_FROM_ENVP = $80; 66 | G_SPAWN_CLOEXEC_PIPES = $100; 67 | 68 | type 69 | TGSpawnChildSetupFunc = procedure(user_data: Pointer); cdecl; 70 | 71 | PVteTerminal = ^TVteTerminal; 72 | TVteTerminal = record 73 | end; 74 | 75 | VTE_TERMINAL = PVteTerminal; 76 | 77 | var 78 | vte_terminal_new: function: PGtkWidget; cdecl; 79 | vte_terminal_fork_command_full: function(terminal: PVteTerminal; pty_flags: TVtePtyFlags; 80 | working_directory: PChar; argv, envv: PPChar; spawn_flags: TGSpawnFlags; 81 | child_setup: TGSpawnChildSetupFunc; child_setup_data: Pointer; child_pid: 82 | PGPid; error: PGError): GBoolean; cdecl; 83 | vte_terminal_set_allow_bold: procedure(terminal: PVteTerminal; allow_bold: GBoolean); cdecl; 84 | vte_terminal_set_font: procedure(terminal: PVteTerminal; font_desc: PPangoFontDescription); cdecl; 85 | vte_terminal_set_color_foreground: procedure(terminal: PVteTerminal; foreground: PGdkColor); cdecl; 86 | vte_terminal_set_color_background: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 87 | vte_terminal_set_color_bold: procedure(terminal: PVteTerminal; foreground: PGdkColor); cdecl; 88 | vte_terminal_set_color_dim: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 89 | vte_terminal_set_color_cursor: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 90 | vte_terminal_set_color_highlight: procedure(terminal: PVteTerminal; background: PGdkColor); cdecl; 91 | 92 | var 93 | Initialized: Boolean; 94 | Loaded: Boolean; 95 | 96 | function TerminalLoad: Boolean; 97 | const 98 | vte = 'libvte.so.9'; 99 | var 100 | Lib: TLibHandle; 101 | 102 | function Load(const ProcName : string; out Proc: Pointer): Boolean; 103 | begin 104 | Proc := GetProcAddress(Lib, ProcName); 105 | Result := Proc <> nil; 106 | end; 107 | 108 | begin 109 | if Initialized then 110 | Exit(Loaded); 111 | Initialized := True; 112 | Lib := LoadLibrary(vte); 113 | if Lib = 0 then 114 | Exit(Loaded); 115 | Loaded := 116 | Load('vte_terminal_new', @vte_terminal_new) and 117 | Load('vte_terminal_fork_command_full', @vte_terminal_fork_command_full) and 118 | Load('vte_terminal_set_allow_bold', @vte_terminal_set_allow_bold) and 119 | Load('vte_terminal_set_font', @vte_terminal_set_font) and 120 | Load('vte_terminal_set_color_foreground', @vte_terminal_set_color_foreground) and 121 | Load('vte_terminal_set_color_background', @vte_terminal_set_color_background) and 122 | Load('vte_terminal_set_color_bold', @vte_terminal_set_color_bold) and 123 | Load('vte_terminal_set_color_dim', @vte_terminal_set_color_dim) and 124 | Load('vte_terminal_set_color_cursor', @vte_terminal_set_color_cursor) and 125 | Load('vte_terminal_set_color_highlight', @vte_terminal_set_color_highlight); 126 | Result := Loaded; 127 | end; 128 | 129 | function TerminalAvailable: Boolean; 130 | begin 131 | Result := TerminalLoad; 132 | end; 133 | 134 | type 135 | TTerminalHack = class(TTerminalControl) 136 | end; 137 | 138 | 139 | procedure TerminalReady(Widget: PGtkWidget); cdecl; 140 | var 141 | Info: PWidgetInfo; 142 | begin 143 | g_signal_handlers_disconnect_by_func(Widget, @TerminalReady, nil); 144 | Info := PWidgetInfo(g_object_get_data(PGObject(Widget), 'widgetinfo')); 145 | TTerminalHack(Info.LCLObject).DoReady; 146 | end; 147 | 148 | procedure TerminalExit(Widget: PGtkWidget); cdecl; 149 | var 150 | Info: PWidgetInfo; 151 | begin 152 | Info := PWidgetInfo(g_object_get_data(PGObject(Widget), 'widgetinfo')); 153 | TTerminalHack(Info.LCLObject).DoTerminate; 154 | end; 155 | 156 | { TTerminal } 157 | 158 | type 159 | TTerminal = class(TInterfacedObject, ITerminal) 160 | private 161 | FControl: TTerminalControl; 162 | FInfo: PWidgetInfo; 163 | protected 164 | procedure SetInfo(Value: Pointer); 165 | procedure SetColor(Element: TTerminalElement; Value: TColor); 166 | procedure SetFont(Value: TFont); 167 | procedure Paint; 168 | procedure Restart; 169 | public 170 | constructor Create(Control: TTerminalControl); 171 | end; 172 | 173 | constructor TTerminal.Create(Control: TTerminalControl); 174 | begin 175 | inherited Create; 176 | FControl := Control; 177 | end; 178 | 179 | procedure TTerminal.SetInfo(Value: Pointer); 180 | begin 181 | if FInfo = nil then 182 | FInfo := Value; 183 | end; 184 | 185 | type 186 | TGdkColor = packed record 187 | pixel: LongWord; 188 | red, green, blue: Word; 189 | end; 190 | 191 | procedure ColorToGdk(C: TColor; out G: TGdkColor); 192 | begin 193 | C := ColorToRGB(C); 194 | G.pixel := 0; 195 | G.red := (C and $FF) * $FF; 196 | G.green := (C shr 8 and $FF) * $FF; 197 | G.blue := (C shr 16 and $FF) * $FF; 198 | end; 199 | 200 | { How to set a Gtk object property: 201 | var 202 | V: TGValue; 203 | begin 204 | V.g_type := G_TYPE_DOUBLE; 205 | V.data[0].v_double := 3; 206 | g_object_set_property(PGObject(Widget), 'scale', @V); 207 | end; } 208 | 209 | procedure TTerminal.SetColor(Element: TTerminalElement; Value: TColor); 210 | var 211 | C: TGdkColor; 212 | begin 213 | if FInfo = nil then 214 | Exit; 215 | ColorToGdk(Value, C); 216 | {%H-}case Element of 217 | teFore: vte_terminal_set_color_foreground(VTE_TERMINAL(FInfo.ClientWidget), @C); 218 | teBack: vte_terminal_set_color_background(VTE_TERMINAL(FInfo.ClientWidget), @C); 219 | teBold: vte_terminal_set_color_bold(VTE_TERMINAL(FInfo.ClientWidget), @C); 220 | teDim: vte_terminal_set_color_dim(VTE_TERMINAL(FInfo.ClientWidget), @C); 221 | { For some reason setting the cursor color causes it to be removed entirely 222 | 223 | teCursor: vte_terminal_set_color_cursor(VTE_TERMINAL(FInfo.ClientWidget), @C); } 224 | teHighlight: vte_terminal_set_color_highlight(VTE_TERMINAL(FInfo.ClientWidget), @C); 225 | end; 226 | end; 227 | 228 | procedure TTerminal.SetFont(Value: TFont); 229 | var 230 | F: PPangoFontDescription; 231 | begin 232 | if FInfo = nil then 233 | Exit; 234 | F := pango_layout_get_font_description({%H-}PGDIObject(Value.Handle).GDIFontObject); 235 | vte_terminal_set_font(VTE_TERMINAL(FInfo.ClientWidget), F); 236 | end; 237 | 238 | procedure TTerminal.Paint; 239 | const 240 | S = 'user@linux~$ bash terminal gtk2'; 241 | var 242 | Canvas: TCanvas; 243 | W, H: Integer; 244 | begin 245 | Canvas := FControl.Canvas; 246 | Canvas.Brush.Style := bsSolid; 247 | Canvas.FillRect(FControl.ClientRect); 248 | W := 0; H := 0; 249 | Canvas.GetTextSize(S, W, H); 250 | Canvas.Font.Color := Canvas.Pen.Color; 251 | Canvas.TextOut((FControl.Width - W) div 2, (FControl.Height - H) div 2, S); 252 | Canvas.Pen.Style := psDash; 253 | Canvas.Pen.Color := clWhite; 254 | Canvas.Brush.Style := bsClear; 255 | Canvas.Rectangle(FControl.ClientRect); 256 | end; 257 | 258 | procedure TTerminal.Restart; 259 | var 260 | Args: array[0..1] of PChar = ('/bin/bash', nil); 261 | begin 262 | if FInfo = nil then 263 | Exit; 264 | gtk_widget_destroy(FInfo.ClientWidget); 265 | FInfo.ClientWidget := vte_terminal_new; 266 | vte_terminal_set_allow_bold(VTE_TERMINAL(FInfo.ClientWidget), True); 267 | vte_terminal_fork_command_full(VTE_TERMINAL(FInfo.ClientWidget), VTE_PTY_DEFAULT, 268 | nil, @Args[0], nil, G_SPAWN_SEARCH_PATH, nil, nil, nil, nil); 269 | gtk_container_add(GTK_CONTAINER(FInfo.CoreWidget), FInfo.ClientWidget); 270 | g_object_set_data(PGObject(FInfo.ClientWidget), 'widgetinfo', FInfo); 271 | gtk_widget_show_all(FInfo.CoreWidget); 272 | g_signal_connect(FInfo.ClientWidget, 'contents-changed', G_CALLBACK(@TerminalReady), nil); 273 | g_signal_connect(FInfo.ClientWidget, 'child-exited', G_CALLBACK(@TerminalExit), nil); 274 | end; 275 | 276 | function NewTerminal(Control: TTerminalControl): ITerminal; 277 | begin 278 | Result := TTerminal.Create(Control); 279 | end; 280 | 281 | procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); 282 | begin 283 | TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject)); 284 | end; 285 | 286 | class function TWSTerminalControl.CreateHandle(const AWinControl: TWinControl; 287 | const AParams: TCreateParams): TLCLIntfHandle; 288 | var 289 | Info: PWidgetInfo; 290 | Style: PGtkRCStyle; 291 | Args: array[0..1] of PChar = ('/bin/bash', nil); 292 | Allocation: TGTKAllocation; 293 | begin 294 | { Initialize widget info } 295 | Info := CreateWidgetInfo(gtk_frame_new(nil), AWinControl, AParams); 296 | Info.LCLObject := AWinControl; 297 | Info.Style := AParams.Style; 298 | Info.ExStyle := AParams.ExStyle; 299 | Info.WndProc := {%H-}PtrUInt(AParams.WindowClass.lpfnWndProc); 300 | { Configure core and client } 301 | gtk_frame_set_shadow_type(PGtkFrame(Info.CoreWidget), GTK_SHADOW_NONE); 302 | Style := gtk_widget_get_modifier_style(Info.CoreWidget); 303 | Style.xthickness := 0; 304 | Style.ythickness := 0; 305 | gtk_widget_modify_style(Info.CoreWidget, Style); 306 | if csDesigning in AWinControl.ComponentState then 307 | Info.ClientWidget := CreateFixedClientWidget(True) 308 | else 309 | begin 310 | Info.ClientWidget := vte_terminal_new; 311 | g_signal_connect(Info.ClientWidget, 'contents-changed', G_CALLBACK(@TerminalReady), nil); 312 | g_signal_connect(Info.ClientWidget, 'child-exited', G_CALLBACK(@TerminalExit), nil); 313 | vte_terminal_set_allow_bold(VTE_TERMINAL(Info.ClientWidget), True); 314 | vte_terminal_fork_command_full(VTE_TERMINAL(Info.ClientWidget), VTE_PTY_DEFAULT, 315 | nil, @Args[0], nil, G_SPAWN_SEARCH_PATH, nil, nil, nil, nil); 316 | TTerminalHack(AWinControl).FTerminal.SetInfo(Info); 317 | end; 318 | GTK_WIDGET_SET_FLAGS(Info.CoreWidget, GTK_CAN_FOCUS); 319 | gtk_container_add(GTK_CONTAINER(Info.CoreWidget), Info.ClientWidget); 320 | g_object_set_data(PGObject(Info.ClientWidget), 'widgetinfo', Info); 321 | gtk_widget_show_all(Info.CoreWidget); 322 | Allocation.X := AParams.X; 323 | Allocation.Y := AParams.Y; 324 | Allocation.Width := AParams.Width; 325 | Allocation.Height := AParams.Height; 326 | gtk_widget_size_allocate(Info.CoreWidget, @Allocation); 327 | SetCallbacks(Info.CoreWidget, Info); 328 | Result := {%H-}TLCLIntfHandle(Info.CoreWidget); 329 | end; 330 | {$endif} 331 | 332 | end. 333 | --------------------------------------------------------------------------------