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
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001, 2004 Institut National de Recherche en Informatique *)
(* et en Automatique. All rights reserved. This file is distributed *)
(* only by permission. *)
(* *)
(***********************************************************************)
(* $Id: mytext.ml,v 1.2 2004/07/07 09:39:15 weis Exp $ *)
(* A text widget with kill and yank capabilities `` la'' Emacs. *)
open Tk;;
let top = openTk ();;
let scroll_link sb tx =
Text.configure tx [YScrollCommand (Scrollbar.set sb)];
Scrollbar.configure sb [ScrollCommand (Text.yview tx)];;
let f = Frame.create top [];;
let text = Text.create f [];;
let scrollbar = Scrollbar.create f [];;
(* kill buffer *)
let kill_ring = ref [];;
let add_to_kill_ring s = kill_ring := s :: !kill_ring;;
let get_killed_text () =
match !kill_ring with
| [] -> ""
| s :: l -> s;;
(* Note: for the text widgets, the insertion cursor is
not TextIndex (Insert, []),
but TextIndex (Mark "insert", []) *)
let insertMark = TextIndex (Mark "insert", []);;
let eol_insertMark = TextIndex (Mark "insert", [LineEnd]);;
let kill () =
let s = Text.get text insertMark eol_insertMark in
add_to_kill_ring s;
prerr_endline ("Killed: " ^ s);
Text.delete text insertMark eol_insertMark;;
let yank () =
let s = get_killed_text () in
Text.insert text insertMark s [];
prerr_endline ("Yanked: " ^ s);;
let yank_more () =
let ring = !kill_ring in
let more = ref ring in
let rec get_killed_more () =
match !more with
| [] -> more := ring; get_killed_more ()
| s :: l -> more := l; s in
let insert_killed_more () =
let s = get_killed_more () in
prerr_endline ("Yanked more: " ^ s);
Text.insert text insertMark s [] in
insert_killed_more ();
bind text [[Alt], KeyPressDetail "y"]
(BindSet ([], fun _ -> insert_killed_more ()));;
let main () =
scroll_link scrollbar text;
pack [text; scrollbar][Side Side_Left; Fill Fill_Y];
pack [f][];
bind text [[Control], KeyPressDetail "y"]
(BindSet ([], fun _ -> yank ()));
bind text [[Alt], KeyPressDetail "y"]
(BindSet ([], fun _ -> yank_more () ));
bind text [[Control], KeyPressDetail "k"]
(BindSet ([], fun _ -> kill () ));
bind text [[Control], KeyPressDetail "c"]
(BindSet ([], fun _ -> exit 0 ));
mainLoop ();;
main ();;
|
