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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
(***********************************************************************)
(* *)
(* MLTk, Tcl/Tk interface of Objective Caml *)
(* *)
(* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis *)
(* projet Cristal, INRIA Rocquencourt *)
(* Jacques Garrigue, Kyoto University RIMS *)
(* *)
(* Copyright 2002 Institut National de Recherche en Informatique et *)
(* en Automatique and Kyoto University. All rights reserved. *)
(* This file is distributed under the terms of the GNU Library *)
(* General Public License, with the special exception on linking *)
(* described in file LICENSE found in the Objective Caml source tree. *)
(* *)
(***********************************************************************)
open Camltk
(*
* Some standard requesters (in Amiga techspeak) or dialog boxes (in Apple
* jargon).
*)
let version = "$Id$"
(*
* Simple requester
* an entry field, unrestricted, with emacs-like bindings
* Note: grabs focus, thus always unique at one given moment, and we
* shouldn't have to worry about toplevel widget name.
* We add a title widget in case the window manager does not decorate
* toplevel windows.
*)
let open_simple title action notaction memory =
let t = Toplevel.create Widget.default_toplevel [Class "Dialog"] in
Focus.set t;
Wm.title_set t title;
let tit = Label.create t [Text title] in
let len = max 40 (String.length (Textvariable.get memory)) in
let e =
Entry.create t [Relief Sunken; TextVariable memory; TextWidth len] in
let activate _ =
let v = Entry.get e in
Grab.release t; (* because of wm *)
destroy t; (* so action can call open_simple *)
action v in
bind e [[], KeyPressDetail "Return"] (BindSet ([], activate));
let f = Frame.create t [] in
let bok = Button.create f [Text "Ok"; Command activate] in
let bcancel = Button.create f
[Text "Cancel";
Command (fun () -> notaction(); Grab.release t; destroy t)] in
bind e [[], KeyPressDetail "Escape"]
(BindSet ([], (fun _ -> Button.invoke bcancel)));
pack [bok] [Side Side_Left; Expand true];
pack [bcancel] [Side Side_Right; Expand true];
pack [tit;e] [Fill Fill_X];
pack [f] [Side Side_Bottom; Fill Fill_X];
Frx_widget.resizeable t;
Focus.set e;
Tkwait.visibility t;
Grab.set t
(* A synchronous version *)
let open_simple_synchronous title memory =
let t = Toplevel.create Widget.default_toplevel [Class "Dialog"] in
Focus.set t;
Wm.title_set t title;
let tit = Label.create t [Text title] in
let len = max 40 (String.length (Textvariable.get memory)) in
let e =
Entry.create t [Relief Sunken; TextVariable memory; TextWidth len] in
let waiting = Textvariable.create_temporary t in
let activate _ =
Grab.release t; (* because of wm *)
destroy t; (* so action can call open_simple *)
Textvariable.set waiting "1" in
bind e [[], KeyPressDetail "Return"] (BindSet ([], activate));
let f = Frame.create t [] in
let bok = Button.create f [Text "Ok"; Command activate] in
let bcancel =
Button.create f
[Text "Cancel";
Command (fun () ->
Grab.release t; destroy t; Textvariable.set waiting "0")] in
bind e [[], KeyPressDetail "Escape"]
(BindSet ([], (fun _ -> Button.invoke bcancel)));
pack [bok] [Side Side_Left; Expand true];
pack [bcancel] [Side Side_Right; Expand true];
pack [tit;e] [Fill Fill_X];
pack [f] [Side Side_Bottom; Fill Fill_X];
Frx_widget.resizeable t;
Focus.set e;
Tkwait.visibility t;
Grab.set t;
Tkwait.variable waiting;
begin match Textvariable.get waiting with
"1" -> true
| _ -> false
end
(*
* Simple list requester
* Same remarks as in open_simple.
* focus seems to be in the listbox automatically
*)
let open_list title elements action notaction =
let t = Toplevel.create Widget.default_toplevel [Class "Dialog"] in
Wm.title_set t title;
let tit = Label.create t [Text title] in
let fls = Frame.create t [Relief Sunken; BorderWidth (Pixels 2)] in
let lb = Listbox.create fls [SelectMode Extended] in
let sb = Scrollbar.create fls [] in
Frx_listbox.scroll_link sb lb;
Listbox.insert lb End elements;
(* activation: we have to break() because we destroy the requester *)
let activate _ =
let l = List.map (Listbox.get lb) (Listbox.curselection lb) in
Grab.release t;
destroy t;
List.iter action l;
break() in
bind lb [[Double], ButtonPressDetail 1] (BindSetBreakable ([], activate));
Frx_listbox.add_completion lb activate;
let f = Frame.create t [] in
let bok = Button.create f [Text "Ok"; Command activate] in
let bcancel = Button.create f
[Text "Cancel";
Command (fun () -> notaction(); Grab.release t; destroy t)] in
pack [bok; bcancel] [Side Side_Left; Fill Fill_X; Expand true];
pack [lb] [Side Side_Left; Fill Fill_Both; Expand true];
pack [sb] [Side Side_Right; Fill Fill_Y];
pack [tit] [Fill Fill_X];
pack [fls] [Fill Fill_Both; Expand true];
pack [f] [Side Side_Bottom; Fill Fill_X];
Frx_widget.resizeable t;
Tkwait.visibility t;
Grab.set t
(* Synchronous *)
let open_passwd title =
let username = ref ""
and password = ref ""
and cancelled = ref false in
let t = Toplevel.create Widget.default_toplevel [Class "Dialog"] in
Focus.set t;
Wm.title_set t title;
let tit = Label.create t [Text title]
and fu,eu = Frx_entry.new_label_entry t "Username" (fun s -> ())
and fp,ep = Frx_entry.new_label_entry t "Password" (fun s -> ())
in
let fb = Frame.create t [] in
let bok = Button.create fb
[Text "Ok"; Command (fun _ ->
username := Entry.get eu;
password := Entry.get ep;
Grab.release t; (* because of wm *)
destroy t)] (* will return from tkwait *)
and bcancel = Button.create fb
[Text "Cancel"; Command (fun _ ->
cancelled := true;
Grab.release t; (* because of wm *)
destroy t)] (* will return from tkwait *)
in
Entry.configure ep [Show '*'];
bind eu [[], KeyPressDetail "Return"]
(BindSetBreakable ([], (fun _ -> Focus.set ep; break())));
bind ep [[], KeyPressDetail "Return"]
(BindSetBreakable ([], (fun _ -> Button.flash bok;
Button.invoke bok;
break())));
pack [bok] [Side Side_Left; Expand true];
pack [bcancel] [Side Side_Right; Expand true];
pack [tit;fu;fp;fb] [Fill Fill_X];
Tkwait.visibility t;
Focus.set eu;
Grab.set t;
Tkwait.window t;
if !cancelled then failwith "cancelled"
else (!username, !password)
|
