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
|
(*
* double_editor.ml
* ----------
* Copyright : (c) 2016, Fabian Bonk <fabian.bonk@bonkii.com>
* Licence : BSD3
*
* This file is a part of Lambda-Term.
*)
open LTerm_geom
let ( >>= ) = Lwt.( >>= )
(* helper functions *)
let make_key ?(ctrl = false) ?(meta = false) ?(shift = false) c =
let code =
match c with
| `Char c -> LTerm_key.Char (Uchar.of_char c)
| `Other key -> key in
{ LTerm_key.control = ctrl; meta; shift; code }
let frame widget =
let frame = new LTerm_widget.frame in
frame#set widget;
frame
let main () =
let waiter, wakener = Lwt.wait () in
let ctrl_c = [make_key ~ctrl:true @@ `Char 'c'] in
let tab = [make_key @@ `Other LTerm_key.Tab] in
let quit = [LTerm_edit.Custom (Lwt.wakeup wakener)] in
let vbox = new LTerm_widget.vbox in
let top_editor = new LTerm_edit.edit () in
let top_frame = frame top_editor in
(* make bottom editor a fixed 10 rows in size *)
let bottom_editor = new LTerm_edit.edit ~size:{ rows = 10; cols = 1 } () in
(* changed my mind: make it 5 rows smaller *)
bottom_editor#set_allocation
{ bottom_editor#allocation with row1 = bottom_editor#allocation.row1 - 5 };
let bottom_frame = frame bottom_editor in
vbox#add top_frame;
(* in versions before PR#42 this would either crash or make the bottom editor unusable *)
vbox#add ~expand:false bottom_frame;
(* exit on C-c *)
top_editor#bind ctrl_c quit;
bottom_editor#bind ctrl_c quit;
let send_key key =
LTerm_edit.Custom (fun () -> vbox#send_event @@ LTerm_event.Key (make_key key)) in
(* switch editors on Tab *)
top_editor#bind tab [send_key @@ `Other LTerm_key.Down];
bottom_editor#bind tab [send_key @@ `Other LTerm_key.Up];
let label = new LTerm_widget.label "Press Tab to switch between editors.\nPress C-c to exit." in
vbox#add ~expand:false label;
Lazy.force LTerm.stdout
>>= fun term ->
LTerm.enable_mouse term
>>= fun () ->
Lwt.finalize
(fun () -> LTerm_widget.run term ~save_state:false ~load_resources:false vbox waiter)
(fun () -> LTerm.disable_mouse term)
let () = Lwt_main.run (main ())
|
