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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
(*
A little bit of a terminal emulator written in Objective CAML.
Copyright (C) 2002 Tim Freeman <tim@fungible.com>
Minor changes by Markus Mottl <markus.mottl@gmail.com>
This software is distributed under the terms of the GNU general
public license.
*)
module String = StringLabels
module Bytes = BytesLabels
(* To start with, just create a subprocess and copy text back and forth
to it. *)
(* Make a subprocess. Hmm, this is imperfect because many programs
decide to buffer their input in this case because its standard
output isn't a terminal. "cat -u" and ocaml are exceptions. *)
let () =
let _locale_ = GtkMain.Main.init () in
let inch, outch = Unix.open_process "ocaml" in
let buffer_size = 10240 in
let exitNoError () = exit 0 in
let window = GWindow.window ~title:"DemoTerm" () in
let text =
GText.view
~editable:false ~wrap_mode:`WORD
~width:80 ~height:24 ~show:true ~packing:window#add () in
text#buffer#insert
"DemoTerm version 0, Copyright (C) 2002 Tim Freeman\n\
DemoTerm comes with ABSOLUTELY NO WARRANTY.\n\
This is free software, and you are welcome to redistribute it \
under certain conditions; for details go find a copy of the \
GNU lesser general public license somewhere.\n";
(* Use this flag to make sure we don't send any more data to the
subprocess after we've closed its input. *)
let closed = ref false in
(* If the event is a key press, return true, otherwise return false.
Returning false is the signal to gtk to try to find another handler
for the event. *)
let receive_key ev =
let s = GdkEvent.Key.string ev in
if GdkEvent.get_type ev = `KEY_PRESS then
let sendit ch =
(* To send a character, insert it into the buffer and copy it to
outch. *)
let tosend = String.make 1 ch in
text#buffer#insert tosend;
output_string outch tosend;
flush outch in
let rec loop pos =
if not !closed && pos < String.length s then
let ch = s.[pos] in
(* If it's a control-d, then close the output stream. *)
if ch = '\004' then (
close_out outch;
closed := true;
) else (
if ch = '\r' then
(* If the user pressed enter, then send a newline. *)
sendit '\n'
else
(* Otherwise send what the user pressed. *)
sendit ch;
loop (pos + 1)) in
let _ = loop 0 in true
else false in
ignore (text#event#connect#key_press ~callback:receive_key);
(* Register a callback to exit if they close the window. *)
(* FIXME Kill the subprocess if it's still running. *)
ignore (window#connect#destroy ~callback:exitNoError);
window#show ();
let copyFromSubprocess () =
let buf = Bytes.make buffer_size 'x' in
let rec copyLoop () =
let len = input inch buf 0 (Bytes.length buf) in
if len > 0 then (
text#buffer#insert Bytes.(to_string @@ sub buf ~pos:0 ~len);
copyLoop ())
else close_in inch in
copyLoop () in
let maingtk = Thread.create GtkThread.main () in
let copyout = Thread.create copyFromSubprocess () in
Thread.join copyout;
GMain.Main.quit ();
Thread.join maingtk
|
